Idée pour optimisation ?

**gus02800** · 15/06/2021, 13h12

Bonjour tout le monde,

Après quelques années sans trop utilisé le VBA, me voici sur un nouveau projet et je bloque sur l'optimisation d'une boucle.

Au début de ma macro (que je vous épargne), je fais des copier/coller de colonnes ( environ 40 colonnes de quasimenet 4000 lignes)

jusque la tout va bien, ensuite je lance une simple boucle for (voir ci dessous) et la c'est horrible, il arrive que l'application plante .... alors si vous avez une idée ou une autre facon de faire je suis preneur, merci par avance !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 
' ici 40x la même instrction de copier/coller de colonnes
With Sheets("MajSmartG")
    .Range("U1", .Range("U65536").End(xlUp).MergeArea).Copy Destination:=Sheets("MajSGStock").Range("BC1")
End With
 
'puis je vide le presse papier
Application.CutCopyMode = False
LastLign = Sheets("MajSGStock").Range("A65536").End(xlUp).Row
 
 
For i = 2 To LastLign
 
Contacteur1 = Sheets("MajSGStock").Range("H" & i)
Contacteur1 = Right(Contacteur1, 2)
 
 If Contacteur1 = "01" Then
    Sheets("MajSGStock").Range("K" & i & ":AA" & i).ClearContents
 
 ElseIf Contacteur1 = "02" Then
    Sheets("MajSGStock").Range("H" & i & ":J" & i).ClearContents
    Sheets("MajSGStock").Range("N" & i & ":AB" & i).ClearContents
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).Copy Destination:=Sheets("MajSGStock").Range("AG" & i & ":AJ" & i)
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).ClearContents
 
 ElseIf Contacteur1 = "03" Then
    Sheets("MajSGStock").Range("H" & i & ":M" & i).ClearContents
    Sheets("MajSGStock").Range("Q" & i & ":AB" & i).ClearContents
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).Copy Destination:=Sheets("MajSGStock").Range("AK" & i & ":AN" & i)
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).ClearContents
 
 ElseIf Contacteur1 = "04" Then
    Sheets("MajSGStock").Range("H" & i & ":P" & i).ClearContents
    Sheets("MajSGStock").Range("T" & i & ":AB" & i).ClearContents
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).Copy Destination:=Sheets("MajSGStock").Range("AO" & i & ":AR" & i)
    Sheets("MajSGStock").Range("AC" & i & ":AF" & i).ClearContents
 
 ElseIf Contacteur1 = "05" Then
    Sheets("MajSGStock").Range("H" & i & ":S" & i).ClearContents
    Sheets("MajSGStock").Range("W" & i & ":AB" & i).ClearContents
 ElseIf Contacteur1 = "06" Then
    Sheets("MajSGStock").Range("H" & i & ":V" & i).ClearContents
    Sheets("MajSGStock").Range("Z" & i & ":AB" & i).ClearContents
 Else
    'MsgBox i
 End If
 
Sheets("SMARTGEO_B").Range("A1:BC1").Copy Destination:=Sheets("MajSGStock").Range("A1:BC1")
Application.CutCopyMode = False
 
Next i

Alors je ne sais pas si la ligne "Application.CutCopyMode = False" est vraiment utile, je ne vois pas différence avec ou sans.

EnjOy !

**Gado2600** · 15/06/2021, 14h59

Hello !

J'ai regardé ce que tu faisais dans ton code et, oui, 4000 copier/coller, ça peut être lourd.

Par contre, j'ai remarqué quelques petites choses qui font que tu pourrais simplifier tout cela, en passant par des formules.

En effet, tu clearcontents toujours la même plage, plus ou moins ajustée et tu copies-colles sur une même plage plus ou moins ajustée.
Et à chaque fois, sur une même ligne.

Donc, pour ne mettrais-tu pas en place des formules qui t'afficheraient les datas en brut, au même format et, à la fin, tu fais ton copier/coller ?

Mon avis que ton code gagnerait énormément en temps d'exécution.

Cordialement,

**ChristianBosch** · 15/06/2021, 15h02

Envoyé par gus02800

Bonjour tout le monde,

Après quelques années sans trop utilisé le VBA, me voici sur un nouveau projet et je bloque sur l'optimisation d'une boucle.

Au début de ma macro (que je vous épargne), je fais des copier/coller de colonnes ( environ 40 colonnes de quasimenet 4000 lignes)

jusque la tout va bien, ensuite je lance une simple boucle for (voir ci dessous) et la c'est horrible, il arrive que l'application plante .... alors si vous avez une idée ou une autre facon de faire je suis preneur, merci par avance !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
Dim ShStk As Worksheet
Set ShStk = ThisWorkbook.Sheets("MajSGStock")
With ShStk
' ici 40x la même instrction de copier/coller de colonnes
With Sheets("MajSmartG")
    .Range("U1", .Range("U65536").End(xlUp).MergeArea).Copy Destination:=.Range("BC1")
End With
 
'puis je vide le presse papier
Application.CutCopyMode = False
LastLign = .Range("A65536").End(xlUp).Row
 
 
For i = 2 To LastLign
 
Contacteur1 = .Range("H" & i)
Contacteur1 = Right(Contacteur1, 2)
 
 
Select Case Contacteur1
 
 Case "01"
    .Range("K" & i & ":AA" & i).ClearContents
 
 Case "02"
    Union(.Range("H" & i & ":J" & i), .Range("N" & i & ":AB" & i)).ClearContents
    .Range("AG" & i & ":AJ" & i).Value = .Range("AC" & i & ":AF" & i).Value
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "03"
    Union(.Range("H" & i & ":M" & i), .Range("Q" & i & ":AB" & i)).ClearContents
    .Range("AK" & i & ":AN" & i).Value = .Range("AC" & i & ":AF" & i).Value
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "04"
    Union(.Range("H" & i & ":P" & i), .Range("T" & i & ":AB" & i)).ClearContents
    .Range("AO" & i & ":AR" & i).Value = .Range("AC" & i & ":AF" & i).Value
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "05"
    Union(.Range("H" & i & ":S" & i), .Range("W" & i & ":AB" & i)).ClearContents
 Case "06"
    Union(.Range("H" & i & ":V" & i), .Range("Z" & i & ":AB" & i)).ClearContents
 Case Else
    'MsgBox i
 End Select
 
 .Range("A1:BC1").Value = Sheets("SMARTGEO_B").Range("A1:BC1").Value
End With
Application.CutCopyMode = False
 
Next i

Alors je ne sais pas si la ligne "Application.CutCopyMode = False" est vraiment utile, je ne vois pas différence avec ou sans.

EnjOy !

Salut, alors j'ai un peu nettoyé le code mais je pense que le probleme vient du fait que les objets que tu manipule sont lourds surtout comparé a un tableau structuré (table).

Il faut également éviter le copier coller. De plus ton if multiple est pas forcement necessaire, il vaut mieux faire avec un select case.

essaye ca :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Dim ShStk As Worksheet
Set ShStk = ThisWorkbook.Sheets("MajSGStock")
With ShStk
' ici 40x la même instrction de copier/coller de colonnes
With Sheets("MajSmartG")
    .Range("U1", .Range("U65536").End(xlUp).MergeArea).Copy Destination:=.Range("BC1")
End With
 
'puis je vide le presse papier
Application.CutCopyMode = False
LastLign = .Range("A65536").End(xlUp).Row
 
 
For i = 2 To LastLign
 
Contacteur1 = .Range("H" & i)
Contacteur1 = Right(Contacteur1, 2)
 
 
Select Case Contacteur1
 
 Case "01"
    .Range("K" & i & ":AA" & i).ClearContents
 
 Case "02"
    Union(.Range("H" & i & ":J" & i), .Range("N" & i & ":AB" & i)).ClearContents
    .Range("AG" & i & ":AJ" & i) = .Range("AC" & i & ":AF" & i)
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "03"
    Union(.Range("H" & i & ":M" & i), .Range("Q" & i & ":AB" & i)).ClearContents
    .Range("AK" & i & ":AN" & i) = .Range("AC" & i & ":AF" & i)
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "04"
    Union(.Range("H" & i & ":P" & i), .Range("T" & i & ":AB" & i)).ClearContents
    .Range("AO" & i & ":AR" & i) = .Range("AC" & i & ":AF" & i)
    .Range("AC" & i & ":AF" & i).ClearContents
 
 Case "05"
    Union(.Range("H" & i & ":S" & i), .Range("W" & i & ":AB" & i)).ClearContents
 Case "06"
    Union(.Range("H" & i & ":V" & i), .Range("Z" & i & ":AB" & i)).ClearContents
 Case Else
    'MsgBox i
 End Select
 
 .Range("A1:BC1") = Sheets("SMARTGEO_B").Range("A1:BC1")
End With
Application.CutCopyMode = False
 
Next i

**gus02800** · 15/06/2021, 18h01

ChristianBosch ... Merci !

Effectivement le code atteint une vitesse d'excution bien plus raisonnable.

J'avais bien l'intention de passer par un "Select Case", dans un second temps mais je ne pensais pas que des boucle If était si gourmande, à moins que ce soit le stockage de la sheets en variable .....

Bref en tout cas merci beaucoup !

Gado2600, ta remarque est tout à fait juste, je vais me pencher également sur ta proposition pour y gagner encore !

Merci

**ChristianBosch** · 16/06/2021, 10h01

Je pense que c'est les copier coller qui sont très lourds, car quand on copie on doit copier toutes les propriétés de l'objet alors que quand on ne prends que la propriété "value" de l'objet range on réalise moins d'opérations. En plus on n'utilise pas le presse papier.

Idée pour optimisation ?

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager