Macro VBA lente

Bonjour,

J'ai une macro VBA qui défille 9255 ligne et, elle est très lente (3"45 d'exécution) en fin bref. Cette macro sert à transférer les data d'une visseuse connectée et de les organiser

Code:

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
 
Sub Btn_Refresh()
'''''''''''''Déclaration d'objet '''''''''''''''
Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean
Dim iCalcul As Integer
Dim Ligne As Integer
Dim LigneRes As Integer
Dim LigneTab As Integer
'Conservation de la configuration existante
BoEcran = Application.ScreenUpdating
BoBarre = Application.DisplayStatusBar
iCalcul = Application.Calculation
BoEvent = Application.EnableEvents
BoSaut = ActiveSheet.DisplayPageBreaks
' Force la configuration
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
 
'''''''''''''Debut du Code'''''''''''''
Ligne = 8
LigneRes = 2
LigneTab = 8
'Vidange de Tableau du PF
While Feuil2.Range("x" & Ligne) <> ""
        Ligne = Ligne + 1
Wend
Feuil2.Range("A8:Y" & Ligne).Value = ""
'Reset Compteur
Ligne = 2
'boucle pour défiler
While Feuil1.Range("a" & LigneRes) <> ""
    'Copie de résultat du pf dans tableau du PF
        'Récupération des data de Résultat du PF
    'info dim
    Feuil2.Range("o" & LigneTab).Value = Feuil1.Range("T" & LigneRes).Value
    'Code Barre
    Feuil2.Range("M" & LigneTab).Value = Feuil1.Range("R" & LigneRes).Value
    'Etape FI
    Feuil2.Range("D" & LigneTab).Value = Right(Feuil2.Range("M" & LigneTab).Value, 7)
    'Statut tous
    Feuil2.Range("E" & LigneTab).Value = Feuil1.Range("A" & LigneRes).Value
    'Statut Couple
    Feuil2.Range("F" & LigneTab).Value = Feuil1.Range("B" & LigneRes).Value
    'Couple mesuré
    Feuil2.Range("G" & LigneTab).Value = Feuil1.Range("C" & LigneRes).Value
    'Statut angle
    Feuil2.Range("H" & LigneTab).Value = Feuil1.Range("D" & LigneRes).Value
    'Angle mesuré
    Feuil2.Range("I" & LigneTab).Value = Feuil1.Range("E" & LigneRes).Value
    'Date
    Feuil2.Range("J" & LigneTab).Value = Feuil1.Range("O" & LigneRes).Value
    'Horaire
    Feuil2.Range("K" & LigneTab).Value = Feuil1.Range("P" & LigneRes).Value
    'Lot de la sequence
    Feuil2.Range("L" & LigneTab).Value = Feuil1.Range("Q" & LigneRes).Value
    '(Projet)
    Feuil2.Range("N" & LigneTab).Value = Feuil1.Range("S" & LigneRes).Value
    'oppérateur
    Feuil2.Range("P" & LigneTab).Value = Feuil1.Range("U" & LigneRes).Value
    'N° Programme
    Feuil2.Range("R" & LigneTab).Value = Feuil1.Range("W" & LigneRes).Value
    'N° gamme
    Feuil2.Range("S" & LigneTab).Value = Feuil1.Range("AD" & LigneRes).Value
    'Statut Lot
    Feuil2.Range("T" & LigneTab).Value = Feuil1.Range("AB" & LigneRes).Value
    'Lot OK
    If Feuil2.Range("T" & LigneTab).Value Like "Lot OK" Then
        Feuil2.Range("U" & LigneTab).Value = 1
    Else
        Feuil2.Range("U" & LigneTab).Value = 0
    End If
    'Etape
    Feuil2.Range("v" & LigneTab).Value = Left(Feuil2.Range("D" & LigneTab).Value, 2)
    'Type
    Feuil2.Range("W" & LigneTab).Value = Left(Feuil2.Range("M" & LigneTab).Value, 1)
    'Serrage - déserrage
    Feuil2.Range("X" & LigneTab).Value = 2
 
 
        'Séparation du N° de Projet et N°de Tranfo
    Feuil2.Range("b" & LigneTab).Value = Left(Feuil2.Range("o" & LigneTab).Value, 6)
    Feuil2.Range("c" & LigneTab).Value = Right(Feuil2.Range("o" & LigneTab).Value, 3)
        'Corespondance du n°de Projet avec le nom de Projet
    'Compteur de ligne
    While Feuil14.Range("a" & Ligne) <> Feuil2.Range("b" & LigneTab).Value And Ligne <> 20
        Ligne = Ligne + 1
    Wend
    Feuil2.Range("a" & LigneTab).Value = Feuil14.Range("b" & Ligne).Value
    'Reset compteur
    Ligne = 2
        'Recherche de la valeur du couple
    While Feuil5.Range("C" & Ligne) <> Feuil2.Range("M" & LigneTab).Value And Ligne <> 1000
        Ligne = Ligne + 1
    Wend
    Feuil2.Range("Q" & LigneTab).Value = Feuil5.Range("D" & Ligne).Value
    'Reset Compteur
    Ligne = 2
    'ID Serrage
    Feuil2.Range("Y" & LigneTab).Value = Feuil2.Range("N" & LigneTab).Value & Feuil2.Range("c" & LigneTab).Value & _
    Feuil2.Range("U" & LigneTab).Value & Feuil2.Range("v" & LigneTab).Value & Feuil2.Range("X" & LigneTab).Value
    'Incrémentation des compteurs du Resultat du PF et Tableau du PF
    LigneRes = LigneRes + 1
    LigneTab = LigneTab + 1
Wend
''''''''''''''Fin Code'''''''''''''''''
Application.ScreenUpdating = BoEcran
Application.DisplayStatusBar = BoBarre
Application.Calculation = iCalcul
Application.EnableEvents = BoEvent
ActiveSheet.DisplayPageBreaks = BoSaut
 
 
End Sub

Ps : excuser l'orthographe dans le code

Bonjour,

Pour un traitement beaucoup plus rapide, il faut travailler sur des tableaux VBA.
C'est plus rapide qu'écrire les cellules une par une et il n'est pas utile d'arrêter les calculs, l'écran, les évènements, ..., vu qu'on intervient plus sur les cellules (sauf pour y transférer directement l'ensemble des résultats)

Merci d'avoir répondu, je me suis renseigné sur les tableaux et je comprends pas bien pouvez-vous m'en dire plus svp ?

Voir les exemples sur le site de Jacques : Tableaux VBA(Array)