Bonjour,

Je suis débutant en VBA.

je developpe une application sur VBA qui permet de comparer 2 fichers (test.xlsx et test2.xlsx) qui se trouvent dans un repertoire ( exemple W:\Ent\DIR\PA\GD\MACRO\test.xlsx)

J'aimerai comparer les 2 fichiers (ci-joint)

Dans le fichier test.xlsx (capture) on a A001= type + main + autre = PLN + PJM +QUA qui donne dans le fichier test2.xlsx (capture1) A001 =PLN;PJM;QUA

ci-joint les fichiers à comparer et mon code.

Merci d'avance.tests2.xlsxtest.xlsx

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
Private Sub CommandButton3_Click()
 
'Evite de voir les opérations intermédiaire sur les fichiers
 
Application.ScreenUpdating = False
 
'déclarations des variables
 
Dim i As Long
Dim j As Long
Dim l As Integer
Dim Trouve As Long
Dim Time1 As Date, Time2 As Date
 
 
 
 
Dim appExcel As Excel.Application
 
 
Dim test2 As Excel.Workbook
Dim tests2 As Excel.Worksheet
Dim test As Excel.Workbook
Dim tests As Excel.Worksheet
 
'parametrage d'appel des fichiers
 
Set appExcel = CreateObject("Excel.Application") 'creation de l'objet permettant d'ouvrir le fichier excel
 
Set test2 = appExcel.Workbooks.Open("W:\Entit\DIR IND\PA\GD\Habib\ONSAN\test2.xlsx") 'classeur
Set tests2 = test2.Worksheets("Documents") 'feuille
 
Set test = appExcel.Workbooks.Open("W:\Entit\DIRIND\PA\GD\Habib\ONSAN\test.xlsx")
Set tests = test.Worksheets("Feuil1")
 
 
i = 4 'initialisation du compteur à 4 car la ligne 1,2,3 contient l'en-tête de chaque donnée
Time1 = Now()
For i = 4 To len(tests2)
While (tests2.Cells(i, 1).Value <> "" And (tests2.Cells(i, 5).Value <> "" Or tests2.Cells(i, 4).Value <> "" Or tests2.Cells(i, 22).Value <> "" Or tests2.Cells(i, 23).Value <> "")) ' tant que dans le fichier test la cellule en (ligne i, colonne A E D V W) n'est pas vide
j = 2
Time2 = Now()
 
'si la cellule du fichier test2 correspond à celle de test alors
For j = 2 To len(tests)
If (tests2.Cells(i, 1).Value = _
tests.Cells(j, 2).Value And (tests.Cells(j, 3).Value = tests2.Cells(i, 5).Value + ";" + tests2.Cells(i, 4).Value + ";" + tests2.Cells(i, _22).Value + ";" + tests2.Cells(i, 23).Value)) Then
Trouve = 1
'On copie le code à la ligne actuelle dans une nouvelle colonne
'tests.Cells(i, 3).Value = '_
'tests2.Cells(j, 2).Value
'j = j + 1
tests.Cells(j, 1).Interior.Color = 2
'tests2.Cells(j, 2).Interior.Color = 2
'sinon on passe à la ligne suivante de icatfiltre
Else
'j = j + 1
tests2.Cells(j, 1).Interior.Color = 27
 
'j = j + 1
End If
Next j
 
i = i + 1
 
Wend
 
Next i
'on ferme le classeur
test.Close
Debug.Print "TestListe :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
 
End Sub