Macro et glisser

R

Robmachine

XLDnaute Nouveau
Bonjour a tous,

J'ai récemment créer une macro sur excel 2007 qui fonctionne correctement.

Celle-ci s'applique dans la colonne AR2 de mon tableau excel, le problème est que, pour chaque ligne de cette colonne je dois activé la macro manuellement ( ctrl+ b) ce qui est assez fastidieux sachant que j'ai au moins une centaines de lignes dans mon tableau qui risque surement d'être enrichi par la suite.

Est-il possible d'appliquer la macro a toute la colonne en question en exécutant la macro a la première ligne, et en faisant glisser jusqu'à la ligne désiré.

Merci d'avance pour vos réponses
 
Trier par date Trier par votes
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Macro et glisser

Bonjour Robmachine et bienvenue sur le forum

Il est en effets facile d'appliquer la macro sur le nombre de lignes que tu souhaites. Cependant sans fichier pour savoir exactement ce que tu souhaites, je ne suis pas sûr de tomber juste. Dans tous les cas, ce sera une instruction de ce type :
VB: 
    For i = 2 To 102
        Range("AR" & i).Select
        Suite de ta macro....
    Next

En ayant ton code réel, je pourrais le rendre plus rationnel et probablement plus rapide en enlevant le .Select.

A+
 
Vote positif 0 Vote négatif
R

Robmachine

XLDnaute Nouveau
Re : Macro et glisser

Tout d'abord merci pour vos réponses aussi rapide, je suis impressionné :)

Malheureusement le fichier provient d'une grande société française, les données sont donc confidentielles.

Par contre je peux te donner le code VBA de ma macro mais ,comment puis-je l’insérer de la même manière que tu l'as fait dans ta réponse ?

Je pense que ce sera plus lisible pour toi qu'un simple copier/coller de mon code
 
Vote positif 0 Vote négatif
R

Robmachine

XLDnaute Nouveau
Re : Macro et glisser

Voici le code:

Sub Interpolation()
'
' Interpolation Macro
' Interpolation linéaire entre deux taux libor pour une date valeur donnée et sa durée de vie en jour.
'

'

Dim nbjexact As Integer
Dim nbjinf As Integer
Dim nbjsup As Integer
Dim txlibinf As Double
Dim txlibsup As Double
Dim DateValeur As Date
Dim txinterpol As Double
Dim i As Integer
i = 1




While i <> ActiveCell.Row

i = i + 1
Wend


nbjexact = Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("AQ" & i)
DateValeur = Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i)






If 1 <= nbjexact And nbjexact <= 7 Then

nbjinf = 1
nbjsup = 7

ElseIf 7 <= nbjexact And nbjexact <= 30 Then

nbjinf = 7
nbjsup = 30

ElseIf 30 <= nbjexact And nbjexact <= 60 Then

nbjinf = 30
nbjsup = 60

ElseIf 60 <= nbjexact And nbjexact <= 90 Then

nbjinf = 60
nbjsup = 90

Else

nbjinf = 90
nbjsup = 120

End If



If nbjinf = 1 Then

txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Historique Libor aout").Range("A1:A100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("B1:B100"))
txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Historique Libor aout").Range("D1:D100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("E1:E100"))

ElseIf nbjinf = 7 Then

txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("D1:D100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("E1:E100"))
txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("G1:G100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("H1:H100"))

ElseIf nbjinf = 30 Then

txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("G1:G100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("H1:H100"))
txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("J1:J100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("K1:K100"))

ElseIf nbjinf = 60 Then


txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$J$1:$J$100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$K$1:$K$100"))
txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$M$1:$M$100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$N$1:$N$100"))


Else

txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsxm.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Historique Libor aout").Range("M1:M100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("N1:N100"))
txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation.xlsxm.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Historique Libor aout").Range("P1:p100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("Q1:Q100"))

End If



txinterpol = (((txlibsup - txlibinf) * (nbjexact - nbjinf)) / (nbjsup - nbjinf)) + txlibinf




ActiveCell.FormulaR1C1 = txinterpol

End Sub


En fait le problème c'est que la personne qui utilisera la macro en question ne connais rien en vba, elle voudra donc surement executer la macro, puis faire un glisser jusqu'à la ligne qu'elle desirera. Bref elle ne saura pas intervenir sur le programme vba et donc ne saura pas capable de modifier la boucle que tu m'as proposé.

Suis-je assez clair ou auriez vous besoin d'autre explication ? :)
 
Vote positif 0 Vote négatif
Fred0o

Fred0o

XLDnaute Barbatruc
Re : Macro et glisser

re-bonjour,

Voici le code un peu relooké et intégrant la boucle qui s'applique de la cellule AR2 à la dernière cellule non vide de la colonne AR.
VB: 
Option Explicit

Sub Interpolation()
'
' Interpolation Macro
' Interpolation linéaire entre deux taux libor pour une date valeur donnée et sa durée de vie en jour.
'

'
    Dim nbjexact As Integer
    Dim nbjinf As Integer
    Dim nbjsup As Integer
    Dim txlibinf As Double
    Dim txlibsup As Double
    Dim DateValeur As Date
    Dim txinterpol As Double
    Dim i As Integer
    For i = 2 To Range("AR" & Range("AR65536").End(xlUp).Row)
        nbjexact = Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("AQ" & i)
        DateValeur = Workbooks("Interpolation.xlsm").Sheets("PTF APPOLO").Range("I" & i)
        If 1 <= nbjexact And nbjexact <= 7 Then
            nbjinf = 1
            nbjsup = 7
            txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Hist orique Libor aout").Range("A1:A100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("B1:B100"))
            txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Hist orique Libor aout").Range("D1100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("E1:E100"))
        ElseIf 7 <= nbjexact And nbjexact <= 30 Then
            nbjinf = 7
            nbjsup = 30
            txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("D1100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("E1:E100"))
            txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("G1:G100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("H1:H100"))
        ElseIf 30 <= nbjexact And nbjexact <= 60 Then
            nbjinf = 30
            nbjsup = 60
            txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("G1:G100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("H1:H100"))
            txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("J1:J100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("K1:K100"))
        ElseIf 60 <= nbjexact And nbjexact <= 90 Then
            nbjinf = 60
            nbjsup = 90
            txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$J$1:$J$100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$K$1:$K$100"))
            txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$M$1:$M$100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("$N$1:$N$100"))
        Else
            nbjinf = 90
            nbjsup = 120
            txlibinf = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsxm.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Hist orique Libor aout").Range("M1:M100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("N1:N100"))
            txlibsup = WorksheetFunction.Lookup(Workbooks("Interpolation. xlsxm.xlsm").Sheets("PTF APPOLO").Range("I" & i), Workbooks("Interpolation.xlsxm.xlsm").Sheets("Hist orique Libor aout").Range("P1:P100"), Workbooks("Interpolation.xlsm").Sheets("Historique Libor aout").Range("Q1:Q100"))
        End If
        txinterpol = (((txlibsup - txlibinf) * (nbjexact - nbjinf)) / (nbjsup - nbjinf)) + txlibinf
        Range("AR" & i) = txinterpol
    Next
End Sub

Si le fichier dans lequel s'exécute la macro est le fichier "Interpolation. xlsm", alors tu peux encore simplofier comme ceci :
VB: 
Option Explicit

Sub Interpolation()
'
' Interpolation Macro
' Interpolation linéaire entre deux taux libor pour une date valeur donnée et sa durée de vie en jour.
'

'
    Dim nbjexact As Integer
    Dim nbjinf As Integer
    Dim nbjsup As Integer
    Dim txlibinf As Double
    Dim txlibsup As Double
    Dim DateValeur As Date
    Dim txinterpol As Double
    Dim i As Integer
    For i = 2 To Range("AR" & Range("AR65536").End(xlUp).Row)
        nbjexact = Sheets("PTF APPOLO").Range("AQ" & i)
        DateValeur = Sheets("PTF APPOLO").Range("I" & i)
        If 1 <= nbjexact And nbjexact <= 7 Then
            nbjinf = 1
            nbjsup = 7
            txlibinf = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("A1:A100"), Sheets("Historique Libor aout").Range("B1:B100"))
            txlibsup = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("D1100"), Sheets("Historique Libor aout").Range("E1:E100"))
        ElseIf 7 <= nbjexact And nbjexact <= 30 Then
            nbjinf = 7
            nbjsup = 30
            txlibinf = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("D1100"), Sheets("Historique Libor aout").Range("E1:E100"))
            txlibsup = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("G1:G100"), Sheets("Historique Libor aout").Range("H1:H100"))
        ElseIf 30 <= nbjexact And nbjexact <= 60 Then
            nbjinf = 30
            nbjsup = 60
            txlibinf = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("G1:G100"), Sheets("Historique Libor aout").Range("H1:H100"))
            txlibsup = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("J1:J100"), Sheets("Historique Libor aout").Range("K1:K100"))
        ElseIf 60 <= nbjexact And nbjexact <= 90 Then
            nbjinf = 60
            nbjsup = 90
            txlibinf = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("$J$1:$J$100"), Sheets("Historique Libor aout").Range("$K$1:$K$100"))
            txlibsup = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Historique Libor aout").Range("$M$1:$M$100"), Sheets("Historique Libor aout").Range("$N$1:$N$100"))
        Else
            nbjinf = 90
            nbjsup = 120
            txlibinf = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Hist orique Libor aout").Range("M1:M100"), Sheets("Historique Libor aout").Range("N1:N100"))
            txlibsup = WorksheetFunction.Lookup(Sheets("PTF APPOLO").Range("I" & i), Sheets("Hist orique Libor aout").Range("P1:P100"), Sheets("Historique Libor aout").Range("Q1:Q100"))
        End If
        txinterpol = (((txlibsup - txlibinf) * (nbjexact - nbjinf)) / (nbjsup - nbjinf)) + txlibinf
        Range("AR" & i) = txinterpol
    Next
End Sub

A+
 
Vote positif 0 Vote négatif

Discussions similaires

Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
238
Akortys
Akortys
S
  • Question
XL 2021 ecrire macro vba
Réponses
2
Affichages
198
Bernard_XLD
Bernard_XLD
B
  • Question
XL 2016 Macro pour identifier un texte dans un tableau et appliquer une modification sur une cellule sur la même ligne
Réponses
5
Affichages
260
ChTi160
ChTi160
chaelie2015
  • Résolu(e)
XL 2013 Masquer/Afficher une ligne de tableau Word en fonction de la valeur du contrôleur de contenu
2
Réponses
20
Affichages
737
chaelie2015
chaelie2015
T
  • Question
XL 2016 La macro efface les formules
Réponses
3
Affichages
253
JHA
J
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
186
merinos
merinos
H
  • Question
XL 2021 Macro en vba
Réponses
4
Affichages
209
Lolote83
L
E
  • Résolu(e)
Autres suppression de l'erreur #ref dans une formule de calcul
Réponses
4
Affichages
226
ermagat
E
O
  • Résolu(e)
XL 2016 Transfert de données sous conditions
Réponses
4
Affichages
200
sylvanu
sylvanu
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
192
ftpo69
F

Membres actuellement en ligne

16 membres et 385 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 299
Messages
2 086 998
Membres
103 425
dernier inscrit
alainPontonnier