Boucle vba

Bonjour à tous,

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

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

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+

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

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

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

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

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

encore moi (excusez moi!)

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

comprend pas ca marche chez moi (XL2003)
D1,E1,F1, sont des formules
https://www.cjoint.com/?jsoPACYJWC

tu dis...

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]))"

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
?

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)

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!

au retour d'un super- concert de jazz manouche et avant d'aller au dodo...

fais attention la ligne
columns("A:C").autofit est très lente (3 sur 20000 évaluations)
je l'ai remplacé par
Columns("A:C").ColumnWidth = 7 pas rapide mais quand m^me moins lente