Boucle vba
thiefer
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
la réponse est probablement très simple mais je ne connais pas vba.
Je veux programmer une boucle dans une macro excel qui copie colle les formules de D1 : F1 en Dx : Fx tant que Ax n'est pas vide.
Merci de toute votre aide,
TF
la réponse est probablement très simple mais je ne connais pas vba.
Je veux programmer une boucle dans une macro excel qui copie colle les formules de D1 : F1 en Dx : Fx tant que Ax n'est pas vide.
Merci de toute votre aide,
TF
16 réponses
Bonjour à tous,
j'ai programmé une boucle comme ceci, cela fonctionne mais c'est un peu long en traitement.
Sauriez-vous comment optimiser ce code ?
j'ai programmé une boucle comme ceci, cela fonctionne mais c'est un peu long en traitement.
Dim fin As Boolean
Dim i As Long
i = 1
Range("D1:F1").Select
Selection.Copy
While fin = False
If Range("A" & i).Value <> "" Then
Range("D" & i).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Else
fin = True
End If
i = i + 1
Wend
Sauriez-vous comment optimiser ce code ?
bonjour,
la correction .... sans trop de changement
Dim fin As Boolean
Dim i As Long
i = 1
Range("D1:F1").Select
Selection.Copy
While fin = False
If Range("A" & i).Value <> "" Then
Range("D1").Select
Cells(i, 4).Select
ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Else
fin = True
End If
i = i + 1
Wend
la correction .... sans trop de changement
Dim fin As Boolean
Dim i As Long
i = 1
Range("D1:F1").Select
Selection.Copy
While fin = False
If Range("A" & i).Value <> "" Then
Range("D1").Select
Cells(i, 4).Select
ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Else
fin = True
End If
i = i + 1
Wend
Salut Bidouilleu_R
Bon je pense m'en tenir à ma solution, test fait sur 20000 enregistrements ==> 1"39
Avec la modification que tu m'as proposée, j'ai stoppé le traitement au bout de 4"30, ~14000 enregistrements avaient été traités.
Merci qd même
@ bientôt
TF
Bon je pense m'en tenir à ma solution, test fait sur 20000 enregistrements ==> 1"39
Avec la modification que tu m'as proposée, j'ai stoppé le traitement au bout de 4"30, ~14000 enregistrements avaient été traités.
Merci qd même
@ bientôt
TF
en fait, j'ai testé ton code et j'ai eu une erreur avec
ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
je t'ai proposé cette modification sans plus.
pour ce qui est d'accélérer le code
une boucle for each sera plus rapide que i=i+1
avec une boucle for each tu peux contrôler que la colonne A est non vide sans faire de boucle while
le if .... then suffira.
donc moins de contrôle et donc plus rapide.
ensuite tu pourras copier (1 fois) et coller plusieurs fois l'élément à condition bien sur de placer le copier
à l'extérieur de la boucle.
mais en même temps une grosse seconde ça le fait aussi..
A+
ActiveCell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
je t'ai proposé cette modification sans plus.
pour ce qui est d'accélérer le code
une boucle for each sera plus rapide que i=i+1
avec une boucle for each tu peux contrôler que la colonne A est non vide sans faire de boucle while
le if .... then suffira.
donc moins de contrôle et donc plus rapide.
ensuite tu pourras copier (1 fois) et coller plusieurs fois l'élément à condition bien sur de placer le copier
à l'extérieur de la boucle.
mais en même temps une grosse seconde ça le fait aussi..
A+
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Salut Bidouilleu_R
Ah oui, ça, ça me plait pas mal, et même pas mal du tout ;-)
Juste, voilà le code que j'ai écrit
Ce qu'il y a c'est que dans ce cas, comment je lui dit d'écrire en colonne D sur la ligne de la cellule en A non vide concernée. Car dans mon code, tu l'as deviné, tout s'écrit en dernière ligne (range d & i) et écrase donc l'enregistrement précédent.
Je pense que là, je suis plus très loin... et ça semble vraiment être beaucoup plus rapide
Merci de ton aide,
TF
Ah oui, ça, ça me plait pas mal, et même pas mal du tout ;-)
Juste, voilà le code que j'ai écrit
Dim i As Integer
i = Range("A1").End(xlDown).Row
Range("D1:F1").Select
Selection.Copy
For Each cel In Range("A2:A" & i)
If cel <> "" Then
Range("D" & i).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next cel
Ce qu'il y a c'est que dans ce cas, comment je lui dit d'écrire en colonne D sur la ligne de la cellule en A non vide concernée. Car dans mon code, tu l'as deviné, tout s'écrit en dernière ligne (range d & i) et écrase donc l'enregistrement précédent.
Je pense que là, je suis plus très loin... et ça semble vraiment être beaucoup plus rapide
Merci de ton aide,
TF
Très bonne progression!!! juste une erreur.
ta macro recopié i fois la ligne en position i.
Note que tu sélectionne la plage destination pour coller ce qui est inutile
puisque
avec correction....
Sub test()
Dim i As Integer
i = Range("A1").End(xlDown).Row
Range("D1:F1").Select
Selection.Copy
For Each cel In Range("A2:A" & i)
If cel <> "" Then
cel.Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next cel
End Sub
avec amélioration.... :)
Sub test()
Dim i As Integer
i = Range("A1").End(xlDown).Row
Range("D1:F1").Select
Selection.Copy
For Each cel In Range("A2:A" & i)
If cel <> "" Then
cel.Offset(0, 3).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False End If
Next cel
End Sub
ta macro recopié i fois la ligne en position i.
Note que tu sélectionne la plage destination pour coller ce qui est inutile
puisque
avec correction....
Sub test()
Dim i As Integer
i = Range("A1").End(xlDown).Row
Range("D1:F1").Select
Selection.Copy
For Each cel In Range("A2:A" & i)
If cel <> "" Then
cel.Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next cel
End Sub
avec amélioration.... :)
Sub test()
Dim i As Integer
i = Range("A1").End(xlDown).Row
Range("D1:F1").Select
Selection.Copy
For Each cel In Range("A2:A" & i)
If cel <> "" Then
cel.Offset(0, 3).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False End If
Next cel
End Sub
Bonjour,
Excusez moi d'intervenir dans ce post
s'il s'agit d'inscrire D1:F1 tant que Ax n'est pas vide, on s'arr^te au 1° vide
je regarde si c'est sur toute une zone avec des vides et des pas vides
Excusez moi d'intervenir dans ce post
s'il s'agit d'inscrire D1:F1 tant que Ax n'est pas vide, on s'arr^te au 1° vide
Dim derlig As Long
derlig = Range("A1").End(xlDown).Row
Range("D1:F" & derlig) = Range("D1:F1").Value
je regarde si c'est sur toute une zone avec des vides et des pas vides
re,
proposition vides pasvides
proposition vides pasvides
Sub vides_pasvides()
Dim nbre As Long, cptr As Long
Application.ScreenUpdating = False
nbre = Application.CountA(Range("A1:A60000"))
lig = 65536
For cptr = 1 To nbre
lig = Columns(1).Find("*", Cells(lig, 1), xlValues).Row
Range(Cells(lig, 4), Cells(lig, 6)) = Range("D1:F3").Value
Next
End Sub
Salut Michel Bidouilleu et thiefer,
Excusez l'incruste, ma question s'adresse à Michel.
Comme on apprends tous les jours, j'aimerais que tu expliques à quoi correspond l' * dans find. J'avoue ne pas comprendre???? lig = Columns(1).Find("*", Cells(lig, 1), xlValues).Row
Merci d'avance
Excusez l'incruste, ma question s'adresse à Michel.
Comme on apprends tous les jours, j'aimerais que tu expliques à quoi correspond l' * dans find. J'avoue ne pas comprendre???? lig = Columns(1).Find("*", Cells(lig, 1), xlValues).Row
Merci d'avance
Merci beaucoup. Dormirai encore moins bête ce soir...
Bonne soirée et bon week end à toi
Edit : peux tu jeter un oeil ici si tu as le temps. Tu as certainement une meilleure solution...
Bonne soirée et bon week end à toi
Edit : peux tu jeter un oeil ici si tu as le temps. Tu as certainement une meilleure solution...
encore moi (excusez moi!)
temps 20000 lignes 1° proposition: 0,3 secondes
2°proposition (sans vide): 7,4 secondes
temps 20000 lignes 1° proposition: 0,3 secondes
2°proposition (sans vide): 7,4 secondes
bin, pour la 1° méthode tu remplaces par
Range("D1:F" & derlig) = Range("D1:F1").FormulaLocal
et pour la 2°
Range(Cells(lig, 4), Cells(lig, 6)) = Range("D1:F1").FormulaLocal
Range("D1:F" & derlig) = Range("D1:F1").FormulaLocal
et pour la 2°
Range(Cells(lig, 4), Cells(lig, 6)) = Range("D1:F1").FormulaLocal
désolé, cela ne fonctionne pas sur mon appli :
je lance la macro, il m'indique erreur d'exécution 1004, erreur définie par l'application ou l'objet
il n'a rempli que la ligne 1 en D, E F
D1 est en #nom.
le curseur est bloqué en F1
je lance le débogage, il me surligne : Range("D1:F" & derlig) = Range("D1:F1").FormulaLocal
alors qu'avec l'attribut .value, ça me mentionne bien la valeur sur tous les enreg !!!
TF
je lance la macro, il m'indique erreur d'exécution 1004, erreur définie par l'application ou l'objet
il n'a rempli que la ligne 1 en D, E F
D1 est en #nom.
le curseur est bloqué en F1
je lance le débogage, il me surligne : Range("D1:F" & derlig) = Range("D1:F1").FormulaLocal
alors qu'avec l'attribut .value, ça me mentionne bien la valeur sur tous les enreg !!!
TF
comprend pas ca marche chez moi (XL2003)
D1,E1,F1, sont des formules
https://www.cjoint.com/?jsoPACYJWC
tu dis...
D1,E1,F1, sont des formules
https://www.cjoint.com/?jsoPACYJWC
tu dis...
Ca, j'avoue que c'est fort de café !!!
J'ai vérifié, et même recopié ton code vba en lieu et place du mien mais toujours rien;
Voici le code complet, il sert à mettre ne forme des champs adresses (en A, adr1, en B, cdpost, en C, ville) :
Tu vois un quelconque bug toi ?
D'autant que je te dis bien que ça fonctionne avec l'attribut .value !!!
XL2003 également en plus...
TF
J'ai vérifié, et même recopié ton code vba en lieu et place du mien mais toujours rien;
Voici le code complet, il sert à mettre ne forme des champs adresses (en A, adr1, en B, cdpost, en C, ville) :
Range("D1").Select
ActiveCell.FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=IF(LEN(RC[-3])=4,""0""&RC[-3],RC[-3])"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
'=====================
'solution michel
'=====================
Dim derlig As Long
derlig = Range("A1").End(xlDown).Row
Range("D1:F" & derlig) = Range("D1:F1").FormulaLocal
Tu vois un quelconque bug toi ?
D'autant que je te dis bien que ça fonctionne avec l'attribut .value !!!
XL2003 également en plus...
TF
tes formules sont en RC
donc essaies avec
Range("D1:F" & derlig) = Range("D1:F1").FormulaR1C1
je viens d'essayer c'est OK
tu dis, comme d'hab
petite remarque au passage:
tu cherches la rapidité et tu colles des "select-selection" ?: c'est ce qui ralentit le plus avec les "copy-paste"
ces 2 manières sont à proscrire autant que faire se peut avec VBA déjà très lent (c'est 1 des premières choses à connaitre quand on passe de l'enregistreur de macro à VBA)
au lieu de:
Range("D1").Select
ActiveCell.FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
je te suggère
Range("D1").FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
donc essaies avec
Range("D1:F" & derlig) = Range("D1:F1").FormulaR1C1
je viens d'essayer c'est OK
tu dis, comme d'hab
petite remarque au passage:
tu cherches la rapidité et tu colles des "select-selection" ?: c'est ce qui ralentit le plus avec les "copy-paste"
ces 2 manières sont à proscrire autant que faire se peut avec VBA déjà très lent (c'est 1 des premières choses à connaitre quand on passe de l'enregistreur de macro à VBA)
au lieu de:
Range("D1").Select
ActiveCell.FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
je te suggère
Range("D1").FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
Bon et bien j'avoue que j'apprends plein de trucs sur ce coup là, c'est vraiment bien !!!
Encore un petite contribution peut-être
En gros donc, je nettoie A, B et C en D, E et F
puis, je copie les valeurs de D, E et F en A, B et C
Enfin je supprimer D, E et F qui ne me servent plus et je fais un autofit des 3 colonnes.
seulement voilà, en appliquant tes conseils, j'ai supprimé les copie/paste et les select. C'est très bien car le code est bcp plus court mais le soucis, c'est que ma macro me ramène les enreg impairs seulement, donc 1 sur 2...
Tu vois ce qui cloche ?
TF
Encore un petite contribution peut-être
Range("D1").FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
Range("E1").FormulaR1C1 = "=IF(LEN(RC[-3])=4,""0""&RC[-3],RC[-3])"
Range("F1").FormulaR1C1 = "=TRIM(PROPER(RC[-3]))"
Dim derlig As Long
derlig = Range("A1").End(xlDown).Row
Range("D1:F" & derlig) = Range("D1:F1").FormulaR1C1
Range("A:C") = Range("D:F").Value
Range("D:F").Delete
Cells.Select
Cells.EntireColumn.AutoFit
En gros donc, je nettoie A, B et C en D, E et F
puis, je copie les valeurs de D, E et F en A, B et C
Enfin je supprimer D, E et F qui ne me servent plus et je fais un autofit des 3 colonnes.
seulement voilà, en appliquant tes conseils, j'ai supprimé les copie/paste et les select. C'est très bien car le code est bcp plus court mais le soucis, c'est que ma macro me ramène les enreg impairs seulement, donc 1 sur 2...
Tu vois ce qui cloche ?
TF
En assemblant ton puzzle, je me demande si ce que tu veux faire n'est pas ceci
colonneA et C: mettre en nom propre et virer les espaces avant et après la donnée
colonne B: si la donnée n'a que 4 caractères, ajouter un zéro devant la donnée
?
colonneA et C: mettre en nom propre et virer les espaces avant et après la donnée
colonne B: si la donnée n'a que 4 caractères, ajouter un zéro devant la donnée
?
bonjour,
y'a un décalage d'une ligne dans ma 1° solution que je ne pige pas (je regarderai + tard)
regarde cette solution 20000lignes en env. 1,5 s
https://www.cjoint.com/?jtnkYesfXj
en prime tu as un chronometre que tu pourras réutiliser ailleurs (le temps valable est au 2° ou 3° essai peut être du à l'activation de l'API)
y'a un décalage d'une ligne dans ma 1° solution que je ne pige pas (je regarderai + tard)
regarde cette solution 20000lignes en env. 1,5 s
https://www.cjoint.com/?jtnkYesfXj
en prime tu as un chronometre que tu pourras réutiliser ailleurs (le temps valable est au 2° ou 3° essai peut être du à l'activation de l'API)
Re, j'vas y yarivé!
a voir:
https://www.cjoint.com/?jtoRgXC070
en fait, c'est la macro baptisée "quifoirait" la plus élégante et la + rapide (1,36sec) et je me filerais bien des .... de ne pas y avoir pensé de suite (ce qui n'explique pas le coup d' 1 ligne / 2...)
quand tu annonçais 1,39 sec lors de ta macro de départ (20000 enregistrements) avec les copy-paste, ça m'a surpris: le l'ai donc recopiée (macro "early") et chronométrée: le chrono ne dépasse pas la minute et manuellement on est à un peu moins de 8 minutes à peu près... comme quoi!
a voir:
https://www.cjoint.com/?jtoRgXC070
en fait, c'est la macro baptisée "quifoirait" la plus élégante et la + rapide (1,36sec) et je me filerais bien des .... de ne pas y avoir pensé de suite (ce qui n'explique pas le coup d' 1 ligne / 2...)
quand tu annonçais 1,39 sec lors de ta macro de départ (20000 enregistrements) avec les copy-paste, ça m'a surpris: le l'ai donc recopiée (macro "early") et chronométrée: le chrono ne dépasse pas la minute et manuellement on est à un peu moins de 8 minutes à peu près... comme quoi!
Je me demande si tu t'es pas engrener la tête pour pas grand chose !!!
C'était 1mn39, pas 1s39
Jai la sale habitude de noter mes temps de courses comme ça et ça t'a peut-être induit en erreur...
J'ai pas encore eu le temps de regarder la solution proposée mais je fais ça dimanche soir ou lundi matin.
Les we sont trop chargés !!!
TF
C'était 1mn39, pas 1s39
Jai la sale habitude de noter mes temps de courses comme ça et ça t'a peut-être induit en erreur...
J'ai pas encore eu le temps de regarder la solution proposée mais je fais ça dimanche soir ou lundi matin.
Les we sont trop chargés !!!
TF
SAlut michel,
évidemment, c'est bcp mieux et plus propre comme ça, la formule directement sur le range pour ne pas avoir à faire de copier coller !!!
En plus, je ne connaissais pas l'activate = false pour ne pas afficher les opérations à l'écran ,très bien aussi !!!
En plus, plus aucun soucis d'1 enreg sur deux, il prend bien tout en compte cette fois. Juste je ne sais pas pourquoi ça clochait avant... contentons-nous de ce qui fonctionne ;-)
Sinon un dernier point, il considère toujours mon code postal en numérique et donc, malgré le concat "0" & cdpost si celui-ci ne comportait que 4 chiffres, il affiche systématiquement seulement les 4 chiffres et supprime allègrement le 0 ajouté...
TF
évidemment, c'est bcp mieux et plus propre comme ça, la formule directement sur le range pour ne pas avoir à faire de copier coller !!!
En plus, je ne connaissais pas l'activate = false pour ne pas afficher les opérations à l'écran ,très bien aussi !!!
En plus, plus aucun soucis d'1 enreg sur deux, il prend bien tout en compte cette fois. Juste je ne sais pas pourquoi ça clochait avant... contentons-nous de ce qui fonctionne ;-)
Sinon un dernier point, il considère toujours mon code postal en numérique et donc, malgré le concat "0" & cdpost si celui-ci ne comportait que 4 chiffres, il affiche systématiquement seulement les 4 chiffres et supprime allègrement le 0 ajouté...
TF
J'ai préféré l'option convertir au format texte :
qu'est-ce que tu en penses ?
TF
' conversion colonne cdpost au format texte
Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 2), TrailingMinusNumbers:=True
qu'est-ce que tu en penses ?
TF
j'avais oublié:
avec la mise au format indiqué ce matin , on a plus besoin de tester la longueur dans la boucle
donc on a:
j'ai regardé ta solution de conversion: pourquoi pas mais ce me parait compliqué... "la mienne" permet de garder les codpost en format nombre, plus pratique à manipuler si tu as des dépendantsS. par contre, si tu fais du publipostage avec Word ta solution est préférable. Donc...
avec la mise au format indiqué ce matin , on a plus besoin de tester la longueur dans la boucle
donc on a:
For cptr = 0 To UBound(tablo)
tablo(cptr, 0) = Trim(StrConv(Cells(cptr + 1, 1), vbProperCase))
tablo(cptr, 1) = Cells(cptr + 1, 2)
tablo(cptr, 2) = Trim(StrConv(Cells(cptr + 1, 3), vbProperCase))
Next
j'ai regardé ta solution de conversion: pourquoi pas mais ce me parait compliqué... "la mienne" permet de garder les codpost en format nombre, plus pratique à manipuler si tu as des dépendantsS. par contre, si tu fais du publipostage avec Word ta solution est préférable. Donc...
