Optimisation macro comparaison / Plantage

**Geoffray69** · 19/07/2013, 16h45

Bonjour a tous,

J'ai fait une macro sous vba qui compare 2 fichiers excel en fonction d'une même colonne inchangée qui correspond a la cle primaire de la base de donnee.

Ma macro fonctionne pour des tableaux de 300 lignes mais mon problème est que je souhaite l'utiliser sur des tableaux de 36 000 lignes et c'est la que ça plante !

Excel et la fenêtre VBA ne répond plus et j'ai souvent une erreur qui me dit que l'application s'est déconnecté du client.

J'ai conscience que mon code n'est pas optimise mais je ne suis pas un pro en VBA.

C'est la que je vous sollicite pour m'aider a optimiser ce code afin que ca ne plante plus si possible.

Merci d'avance a vous.

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
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
Private Sub IdentifieProbleme_Click()
Dim Nom1 As String
Dim Nom2 As String
Dim i As Long
Dim max1 As Long
Dim max2 As Long
'j'ouvre les deux classeur
 
Nom1 = ThisWorkbook.Name 'Fichier1.xls
 
Call Ouvre
Nom2 = ActiveWorkbook.Name ' fichier2.xls
Windows(Nom1).Activate
 
max1 = Range("E65536").End(xlUp).Row
 
Windows(Nom2).Activate
 
max2 = Range("E65536").End(xlUp).Row
 
UserForm1.Height = 177
 
compteur = 0
 
 
For i = 4 To max1
    drapeau = False
    j = 4
 
    While drapeau = False
    g1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("G" & i).Value
    g2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("G" & j).Value
 
    e1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("E" & i).Value
    e2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("E" & j).Value
 
    z1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("Z" & i).Value
    z2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("Z" & j).Value
 
    h1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("H" & i).Value
    h2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("H" & j).Value
 
    ai1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("AI" & i).Value
    ai2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("AI" & j).Value
 
    aj1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("AJ" & i).Value
    aj2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("AJ" & j).Value
 
    ak1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("AK" & i).Value
    ak2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("AK" & j).Value
 
    al1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("AL" & i).Value
    al2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("AL" & j).Value
 
    am1 = Workbooks(Nom1).Worksheets("Master Extraction").Range("AM" & i).Value
    am2 = Workbooks(Nom2).Worksheets("Master Extraction").Range("AM" & j).Value
 
 
    compteur = compteur + 1
 
 
        If Val(g1) = Val(g2) Then
        drapeau = True
            If e1 <> e2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("E" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("E" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("E" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("E" & j).Font.ColorIndex = 4
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
                problemee = problemee + 1
            End If
 
            If z1 <> z2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("Z" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("Z" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("Z" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("Z" & j).Font.ColorIndex = 4
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
                problemez = problemez + 1
            End If
 
            If h1 <> h2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("H" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("H" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("H" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("H" & j).Font.ColorIndex = 4
                problemeh = problemeh + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
            If ai1 <> ai2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AI" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AI" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AI" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AI" & j).Font.ColorIndex = 4
                problemeai = problemeai + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
            If aj1 <> aj2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AJ" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AJ" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AJ" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AJ" & j).Font.ColorIndex = 4
                problemeaj = problemeaj + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
            If ak1 <> ak2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AK" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AK" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AK" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AK" & j).Font.ColorIndex = 4
                problemeak = problemeak + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
            If al1 <> al2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AL" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AL" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AL" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AL" & j).Font.ColorIndex = 4
                problemeal = problemeal + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
            If am1 <> am2 Then
                couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd))
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AM" & i).EntireRow.Interior.Color = couleur
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AM" & j).EntireRow.Interior.Color = couleur
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AM" & i).Font.ColorIndex = 4
                Workbooks(Nom2).Worksheets("Master Extraction").Range("AM" & j).Font.ColorIndex = 4
                problemeam = problemeam + 1
                Workbooks(Nom1).Worksheets("Master Extraction").Range("AB" & i).Value = 1
    Workbooks(Nom2).Worksheets("Master Extraction").Range("AB" & j).Value = 1
            End If
 
 
        End If
 
        If compteur Mod ((max1 * max2) / 100) = 0 Then
        progression = progression + 1
        Label1.Width = progression * (label_barre.Width) / 100
        label_barre.Caption = progression & "%"
        DoEvents
        End If
 
        If i = max1 And j = max2 Then
        progression = 100
        Label1.Width = progression * (label_barre.Width) / 100
        label_barre.Caption = progression & "%"
        DoEvents
        End If
 
        j = j + 1
         If j = max2 Then
        Exit For
        End If
    Wend
Next i
Application.ScreenUpdating = True
If probleme > 0 Then MsgBox "Il y a " & probleme & " erreurs", vbCritical Else MsgBox "Il n'y a pas d'erreurs"
 
UserForm1.Height = 132
 
Windows(Nom1).Activate
 
End Sub

**EngueEngue** · 19/07/2013, 16h55

Tu as des variables non déclarées CF Compteur J ... pour ce qui est de la déconexion du client.. montre nous ta macro Ouvre.

Solution récupérer le fichier en local avant de comparer ?

**parmi** · 19/07/2013, 21h58

Bonjour,

Je vois ceci

Code :

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

Application.ScreenUpdating = True

Mais je ne vois pas où tu le mets à False.
Es-tu certain que ce soit à False quand tu lances cette macro ?

**patricktoulon** · 20/07/2013, 15h16

bonjour

le principe est un peu bancale

j'explique :
ici!!! tu determine les limites page fichier1 et fichier 2

Code :

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

1
2
3
4
5
6
7
 
Call Ouvre
Nom2 = ActiveWorkbook.Name ' fichier2.xls
Windows(Nom1).Activate
 max1 = Range("E65536").End(xlUp).Row
 Windows(Nom2).Activate
 max2 = Range("E65536").End(xlUp).Row

et maintenant ici tu boucle sur la valeur max fichier 1 sur les deux fichiers

Code :

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

1
2
3
For i = 4 To max1
    drapeau = False
    j = 4

et tu te recupere en bas de macro avec j=j+1

sauf que j=4 est a l'interieur de la boucle

en fin bref ca n'est pas tres bien concu surtout si tu a X0000 lignes a traiter

essaie de regarder un peu du coté des variables tableaux

**Geoffray69** · 22/07/2013, 10h00

Bonjour a tous,

EngueEngue: je vais declarer toutes mes variables

Ma macro ouvre est la suivante :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Ouvre()
Dim wbMyWb As Workbook
Dim Nom_Fichier As Variant
 
 
Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls")
If Nom_Fichier <> False Then
   Set wbMyWb = Workbooks.Open(Nom_Fichier)
  wbMyWb.Activate
End If
 
End Sub

parmi: J'ai ajouté

Code :

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

Application.ScreenUpdating = False

au début.

patricktoulon: ma premiere boucle parcours tous le premier fichier et ma deuxieme avec le while je cherche a ne pas parcourir tous le deuxieme fichier si la condition est deja vraie.
Je vais regarder les variables tableaux.

Merci a tous pour votre aide

Optimisation macro comparaison / Plantage

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager