Discussion :

[fredems]

Bonjour,

Je suis novice en VBA et j'aimerai accélérer une macro excel.

La macro effectue une recherche dans une feuille nommée "DATA_INPUT" et renvoi une information dans une feuille nommée "ANALYSIS". Je me demandais comment on pouvait accélérer 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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub Extrait_Valeurs_lignes()
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ligne, i As Long
    Dim niv_prod_label As String
    Dim flag_trouve As Range
    Dim FeuilleData, FeuilleAnalysis As Worksheet
 
    Set FeuilleData = ActiveWorkbook.Worksheets("DATA_INPUT")
    Set FeuilleAnalysis = ActiveWorkbook.Worksheets("ANALYSIS")
 
    ligne = 1
 
    Dim v As Long
 
    Set DeletePlage = FeuilleData.Cells.Find("5 - VALEUR MOYENNE ENTRE 0 ET T", LookAt:=xlWhole, MatchCase:=True)
 
 
    For v = 1 To DeletePlage.Row - 1
    FeuilleData.Cells(v).EntireRow.Delete
 
    Next
 
    Do Until (FeuilleAnalysis.Cells(ligne, 2).Value = "END" Or ligne = 40000)
    niv_prod_label = FeuilleAnalysis.Cells(ligne, 2).Value
    If niv_prod_label = "" Then
    GoTo lignesuivante
    End If
 
    Set flag_trouve = FeuilleData.Cells.Find(FeuilleAnalysis.Cells(ligne, 2).Value, LookAt:=xlWhole, MatchCase:=True)
 
    If flag_trouve Is Nothing Then
    MsgBox "Niveau " & niv_prod_label & " non trouvé dans DATA_INPUT !!"
    FeuilleAnalysis.Cells(ligne, 3).Value = Null
    GoTo lignesuivante
    End If
 
    FeuilleAnalysis.Cells(ligne, 3).Value = FeuilleData.Cells(flag_trouve.Row, 3).Value
 
 
    lignesuivante:
    ligne = ligne + 1
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Terminé"
 
 
    End Sub

Comme je ne veux pas supprimer les valeurs de la feuille data_input, j'avais penser à copier tout d'abord les valeurs dans une autre feuille ex: data_input2 et de supprimer au fur et à mesure les lignes dans data_input mais je ne sais pas si cela vaut le coup en terme de temps d’exécution.

Merci d'avance pour vos conseils.

[vinc_bilb]

Bonjour,

Difficile pour moi de vous donner une quelconque piste sans exemple .... sauf cette partie

Code :

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

1
2
3
4
For v = 1 To DeletePlage.Row - 1
    FeuilleData.Cells(v).EntireRow.Delete
 
Next

=> c'est terrible d'un point de vue temps d'exécution, même avec un affichage non raffraichit et je ne vois pas ce qui vous empêche de faire le 'delete' en un coup

[Thautheme]

Bonjour le fil, bonjour le forum,

Désolé Fredems, mais j'ai modifié par habitude le nom de certaines de tes variables. Je ne sais pas si c'est cette partie qui ralentit l'exécution du code, j'ai repris l'idée de Vinc_bilb, mais voici le début du code modifié :

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
Dim OD As Object 'déclare la variable OD (Onglet DATA_INPUT)
Dim OA As Object 'déclare la variable OA (Onglet ANALYSIS)
Dim ligne As Long, i As Long
Dim R As Range 'déclare la varialbe R (Recherche)
Dim LI As Long 'déclare la variable LI (LIgne)
Dim niv_prod_label As String
Dim flag_trouve As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Set OD = ActiveWorkbook.Worksheets("DATA_INPUT") 'définit l'onglet OD
Set OA = ActiveWorkbook.Worksheets("ANALYSIS") 'définit l'onglet OA
Set R = OD.Cells.Find("5 - VALEUR MOYENNE ENTRE 0 ET T", LookAt:=xlWhole, MatchCase:=True) 'définit la recherche R
If Not R Is Nothing Then 'condition : si il existe au moint une occurrence touvée
    LI = R.Row - 1 'définit la ligne LI
    Rows("1:" & LI).Delete 'supprime les lignes 1 à LI
End If 'fin de la condition
ligne = 1

[fredems]

J'ai moi aussi modifié la macro et la durée d’exécution devient raisonnable.

Merci à vous deux