Diminuer le temps d'execution d'un Code VBA

[homekore]

Bonjour à tous,



Grâce a ce forum, je commence de plus en plus à coder en VBA pour faciliter l'utilisation d'excel.


J'ai réalisé un code qui me permet de chercher une valeur se trouvant dans un autre onglet et d'y recopier les colonnes correspondantes.

Le probleme est que la copie de colonnes prend environ 1 seconde, et cela pour les 2500 lignes du fichier.

Je souhaiterai diminuer le plus possible ce temps d'execution, et je pense que ca soit possible vu l'aspect de mon code qui ne m'a pas l'air optimiser du tout.


voici le code

Sub RechercheCopie()
Dim Nom As String, i As Long, j As Long
Sheets(1).Select
i = 2
With Sheets(2)



Range("W2:AQ2623").Select
Selection.ClearContents
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With




Do While Cells(i, 1) <> ""
Nom = Cells(i, 1)
For j = 2 To .Range("A65536").End(xlUp).Row
If (Nom = .Cells(j, 1) And .Cells(j, 2) <> "") Then


Cells(i, 23) = .Cells(j, 2)
Cells(i, 24) = .Cells(j, 3)
Cells(i, 25) = .Cells(j, 4)
Cells(i, 26) = .Cells(j, 5)
Cells(i, 27) = .Cells(j, 6)
Cells(i, 28) = .Cells(j, 7)
Cells(i, 29) = .Cells(j, 8)
Cells(i, 30) = .Cells(j, 9)
Cells(i, 31) = .Cells(j, 10)
Cells(i, 32) = .Cells(j, 11)
Cells(i, 33) = .Cells(j, 17)
Cells(i, 34) = .Cells(j, 18)

Cells(i, 35) = .Cells(j, 35)
If .Cells(j, 35) = .Cells(j, 13) Then
Cells(i, 35).Font.Color = -16776961
End If

Cells(i, 36) = .Cells(j, 37)
If .Cells(j, 37) = .Cells(j, 15) Then
Cells(i, 36).Font.Color = -16776961
End If

Cells(i, 37) = .Cells(j, 49)
If .Cells(j, 49) = .Cells(j, 20) Then
Cells(i, 37).Font.Color = -16776961
End If

Cells(i, 38) = .Cells(j, 51)
If .Cells(j, 51) = .Cells(j, 22) Then
Cells(i, 38).Font.Color = -16776961
End If

Cells(i, 39) = .Cells(j, 39)
If .Cells(j, 39) = .Cells(j, 24) Then
Cells(i, 39).Font.Color = -16776961
End If

Cells(i, 40) = .Cells(j, 41)
If .Cells(j, 41) = .Cells(j, 27) Then
Cells(i, 40).Font.Color = -16776961
End If

Cells(i, 41) = .Cells(j, 43)
If .Cells(j, 43) = .Cells(j, 29) Then
Cells(i, 41).Font.Color = -16776961
End If

Cells(i, 42) = .Cells(j, 45)
If .Cells(j, 45) = .Cells(j, 31) Then
Cells(i, 42).Font.Color = -16776961
End If

Cells(i, 43) = .Cells(j, 47)
If .Cells(j, 47) = .Cells(j, 33) Then
Cells(i, 43).Font.Color = -16776961
End If

Exit For
End If
Next
i = i + 1
Loop
End With
End Sub

Merci d'avance pour vos suggestions.

 

[jeanpierre]

Re : Diminuer le temps d'execution d'un Code VBA

Bonjour homekore,

N'ayant pas de fichier sous les yeux, difficile de te dire si l'on peut améliorer le temps de travail (pas envie de détailler le code).

Une seconde c'est quoi ? Si c'était 10 minutes on pourrait se poser la question...

Néanmoins, et même si cela est possible, ne pas oublier de le comparer à un travail manuel pour un résultat identique. VBA fait des miracles mais pas plus qu'il ne peut le faire, même avec les doigts experts de nos amis de la seconde gagnée.

Bon après-midi.

Jean-Pierre

 

[job75]

Re : Diminuer le temps d'execution d'un Code VBA

Bonjour homekore,

Déjà, à la place de :

Cells(i, 23) = .Cells(j, 2)
Cells(i, 24) = .Cells(j, 3)
Cells(i, 25) = .Cells(j, 4)
Cells(i, 26) = .Cells(j, 5)
Cells(i, 27) = .Cells(j, 6)
Cells(i, 28) = .Cells(j, 7)
Cells(i, 29) = .Cells(j, 8)
Cells(i, 30) = .Cells(j, 9)
Cells(i, 31) = .Cells(j, 10)
Cells(i, 32) = .Cells(j, 11)
Cells(i, 33) = .Cells(j, 17)
Cells(i, 34) = .Cells(j, 18)

écrire :

Cells(i, 23).Resize(, 10) = .Cells(j, 2).Resize(, 10).Value
Cells(i, 33).Resize(, 2) = .Cells(j, 17).Resize(, 2).Value

Edit : salut jeanpierre, pas rafraîchi

A+

 

[homekore]

Re : Diminuer le temps d'execution d'un Code VBA

Bonjour homekore,

Une seconde c'est quoi ? Si c'était 10 minutes on pourrait se poser la question...

Jean-Pierre

Je me suis mal exrpimé, la recopie prend une seconde par Lignes, et comme j'ai plus de 2000 lignes, au final ca fait plus de 20 minutes la mise à jour du fichier.

Je vais essayé de nettoyer le fichier et de le mettre en pièce jointe.

 

[homekore]

Re : Diminuer le temps d'execution d'un Code VBA

Bonjour homekore,

Déjà, à la place de :

Cells(i, 23) = .Cells(j, 2)
Cells(i, 24) = .Cells(j, 3)
Cells(i, 25) = .Cells(j, 4)
Cells(i, 26) = .Cells(j, 5)
Cells(i, 27) = .Cells(j, 6)
Cells(i, 28) = .Cells(j, 7)
Cells(i, 29) = .Cells(j, 8)
Cells(i, 30) = .Cells(j, 9)
Cells(i, 31) = .Cells(j, 10)
Cells(i, 32) = .Cells(j, 11)
Cells(i, 33) = .Cells(j, 17)
Cells(i, 34) = .Cells(j, 18)

écrire :

Cells(i, 23).Resize(, 10) = .Cells(j, 2).Resize(, 10).Value
Cells(i, 33).Resize(, 2) = .Cells(j, 17).Resize(, 2).Value

Edit : salut jeanpierre, pas rafraîchi

A+

Pas mal, merci JOB, effectivement le temps d'execution est divisé par deux grace a ton code, merci !

 

[job75]

Re : Diminuer le temps d'execution d'un Code VBA

Bonjour homekore, le fil,

Ce qui prend beaucoup de temps aussi, c'est de formater les cellules une par une.

Donc modifier chaque groupe de code en déterminant une plage :

Dim plage as range
'----------
Cells(i, 35) = .Cells(j, 35)
If .Cells(j, 35) = .Cells(j, 13) Then
Set plage = Union(IIf(plage Is Nothing, Cells(i, 35), plage), Cells(i, 35))
End If
'-----------
If Not plage Is Nothing Then plage.Font.Color = -16776961 'à la fin

A+

 

[soenda]

Re : Diminuer le temps d'execution d'un Code VBA

Bonsoir le fil, homekore, jeanpierre, job75

Pas de réponse, mais 2 questions :

Question 1 : Qans l'exemple ci-dessous, quelle feuille est sélectionnée, et à quoi sert la ligne "Sheets(1).Select" ?
- Proverbe VBAiste: Un Select chasse l'autre

Sub RechercheCopie()
...
[B][COLOR=blue]Sheets(1).Select[/COLOR][/B]
...
With [B][COLOR=blue]Sheets(2)[/COLOR][/B]
Range("W2:AQ2623")[B][COLOR=blue].Select[/COLOR][/B]
...

Question 2 : Et pour mon érudition, que signifie la ligne suivante ?

If (Nom = .Cells(j, 1) And .Cells(j, 2) <> "") Then

A plus