Macro et glisser

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Robmachine
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

Robmachine

Guest
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
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
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
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😀100"), 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😀100"), 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😛100"), 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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

M
  • Résolu(e)
Microsoft 365 $ Macro pour copier un exemple et$.....
Réponses
9
Affichages
522
sousou
sousou
C
  • Résolu(e)
XL 2016 Macro permettant d'automatiser le tri d'un tableau Excel et de différencier les lignes
Réponses
5
Affichages
252
Chris1263
C
U
  • Question Question
Autres [RÉSOLU] Macro qui bug et je ne sais pas la corriger!!!
Réponses
7
Affichages
451
un internaute
U
F
  • Question Question
Microsoft 365 macro-formule pour recopier une ligne automatiquement à chaque changement de nom
Réponses
5
Affichages
378
Cousinhub
Cousinhub
arck
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
646
AtTheOne
AtTheOne
M
  • Question Question
XL 2021 Automatiser Changements des plages de données Graphique
Réponses
0
Affichages
228
Michel_ja
M
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
29
Affichages
2 K
TooFatBoy
TooFatBoy
jaclam
  • Question Question
Microsoft 365 Bug sur une macro
Réponses
6
Affichages
463
jaclam
jaclam
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
575
fanch55
fanch55
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
429
vgendron
vgendron
jeff1494
  • Question Question
XL 2021 [Résolu] MFC et tableau structuré
Réponses
14
Affichages
1 K
jeff1494
jeff1494
Titof06
  • Résolu(e)
XL 2019 Enregistrement au format ".txt" AVEC et SANS Guillemets
2
Réponses
15
Affichages
918
Titof06
Titof06
M
  • Question Question
XL 2021 Fichier de suivi avec liens et formules
Réponses
4
Affichages
506
Mily74
M
P
  • Question Question
XL 2016 VBA Appliquer un filtre sur mes données importées
Réponses
4
Affichages
683
sousou
sousou
D
  • Résolu(e)
Microsoft 365 Assistance pour optimisation d'un code VBA qui ne fonctionne pas comme souhaité
2
Réponses
21
Affichages
1 K
desto
D
P
  • Question Question
XL 2019 Macro VBA SOMME.SI.ENS
Réponses
2
Affichages
286
sylvanu
sylvanu
N
  • Résolu(e)
XL 2019 Macro pour copier ligne avec case à cocher liée
Réponses
12
Affichages
557
Phil69970
Phil69970
E
  • Résolu(e)
Microsoft 365 Reduire Temps Execution Code
Réponses
5
Affichages
493
eric72
E
patricktoulon
démarrer un fichier importer du web en toute securité
Réponses
7
Affichages
751
patricktoulon
patricktoulon
P
  • Résolu(e)
Microsoft 365 Macro Excel pour effectuer des opérations sur les lignes et cellules adjacentes
2
Réponses
19
Affichages
757
Perceval973
P
Retour