Discussion :

[douwapp]

Bonjour,

Je suis en train de réaliser une macro sur un fichier que je mets à jour quotidiennement afin de m'éviter toutes les modifications manuelles. La macro entière fonctionne mais est fortement ralentie par une des tâches:
Je veux remplacer les valeurs de la colonne W en fonction de celles de la colonne X. C'est à dire, si X1="11" alors W1="M". Si X2="12" alors W2="M+1".
J'ai donc réalisé la macro suivante:

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
Sub Descendre_lignes()
ActiveSheet.Select
 Dim A As Integer
 A = 3
 
 Do While Range("W" & A).Value > 0
 
 If Range("W" & A).Value = "11" Then
 Range("X" & A).Value = "M"
 Else
 If Range("W" & A).Value = "12" Then
Range("X" & A).Value = "M+1"
Else
 If Range("W" & A).Value = "1" Then
 Range("X" & A).Value = "M+2"
 Else
 If Range("W" & A).Value = "2" Then
 Range("X" & A).Value = "M+3"
 
 Else: Range("X" & A).Value = "Over"
End If
End If
End If
End If
 
 
A = A + 1
 
 Loop

Elle fonctionne mais est super lente, d'autant plus qu'il peut y'avoir jusqu'à 5000 lignes à traiter. Mes connaissances en VBA étant très limitées, est ce que quelqu'un saurait comment la "simplifier" ?
Merci d'avance

PS : Je sais bien qu'il serait plus facile d'utiliser une simple formule mais le but de cette macro est de tout automatiser et je dois également pouvoir effectuer des modifications sur la colonne W, ce qui casserait les formules.

[tototiti2008]

Bonjour,

Peut-être juste désactiver l'écran, ça ferait gagner du temps

au début du code, après Sub

Code :

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

Application.Screenupdating = False

à la fin du code, avant End Sub

Code :

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

Application.Screenupdating = True

[douwapp]

Hello Tototiti,

Merci pour ta réponse, je viens de tester c'est toujours aussi long ..

[tototiti2008]

ça ne devrait pas
des formules se recalculent à chaque changement de valeur en colonne X ?

[hyperion13]

Salut
Qu'entendez-vous par c'est lent ? Tout est question de point de vue, de machine, etc.
De plus comment mesurez-vous la vitesse d'exécution ? A la louche ? Parce que vous n'avez même pas de Timer vous vous indiquer le temps d'exécution !

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
Sub testrapidite()
Dim xlwbs As Worksheet
Dim rng As Range, c As Range
Dim i As Integer
Dim start As Single
 
Set xlwbs = Worksheets("Feuil1")
 
With xlwbs
    Set rng = .Range("W2", .Cells(.Rows.Count, 23).End(xlUp))
End With
 
start = Timer
 
For Each c In rng.Cells
Select Case c
    Case "11"
        c.Offset(0, 1).Value = "M"
    Case "12"
        c.Offset(0, 1).Value = "M+1"
    Case "1"
        c.Offset(0, 1).Value = "M+2"
    Case "2"
        c.Offset(0, 1).Value = "M+3"
    Case Else
        c.Offset(0, 1).Value = "Over"
End Select
Next
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

[douwapp]

@tototiti2008 Oui c'est ça. Ça le fait ligne par ligne. C'est pour ça que je cherchais une autre façon d'écrire la macro qui pourrait m'éviter de passer par loop (je pense que c'est la que ça bloque)

@Hyperion13 Salut, la macro met environ 10 mn sur mon fichier test avec 1500 lignes. Je pense que c'est suffisamment long pour être considéré comme lent non ?

[tototiti2008]

Bonsoir,

Adaptation du code de hyperion :

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
Sub testrapidite()
Dim xlwbs As Worksheet
Dim rng As Range, c As Range
Dim i As Integer, Tabl
Dim start As Single
 
Set xlwbs = Worksheets("Feuil1")
 
With xlwbs
    Tabl = .Range("W2", .Cells(.Rows.Count, 23).End(xlUp)).Value
End With
 
start = Timer
 
For i = 1 To UBound(Tabl, 1)
Select Case Tabl(i, 1)
    Case "11"
        Tabl(i, 1) = "M"
    Case "12"
        Tabl(i, 1) = "M+1"
    Case "1"
        Tabl(i, 1) = "M+2"
    Case "2"
        Tabl(i, 1) = "M+3"
    Case Else
        Tabl(i, 1) = "Over"
End Select
Next i
 
xlwbs.Range("X2").Resize(UBound(Tabl, 1), 1).Value = Tabl
 
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub

[douwapp]

Je viens de tester le code il marche parfaitement en moins d'une seconde! Top merci beaucoup à vous 2 !