Application en VBA

Version imprimable

2 pièce(s) jointe(s)

Application en VBA

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.Pièce jointe 179108 Pièce jointe 179109

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
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

28/05/2015, 22h48
joe.levrai

Bonjour,

et quelle est la question et/ou le problème ? Avec les détails associés (dans quel code, à quelle ligne ... quelle méthode/comportement tu n'arrives pas à gérer etc...)

balise également ton code, là c'est quelque peu "illisible"
28/05/2015, 22h49
Quentin77170

Bonsoir, je n'aurai pas le temps de regarder ceci ce soir, mais pourrais-tu placer ton code entre les balises [ CODE] et [ /CODE] (sans les espaces après les ouvertures de crochets. ou en appuyant sur le bouton # de l'éditeur de texte quand tu modifieras ton message ?

Ce serait bien plus lisible. :)

Quentin

2 pièce(s) jointe(s)

ci-joint les 2 fichiers
Pièce jointe 179112 Pièce jointe 179113

Citation:

Envoyé par Quentin77170

Bonsoir, je n'aurai pas le temps de regarder ceci ce soir, mais pourrais-tu placer ton code entre les balises [ CODE] et [ /CODE] (sans les espaces après les ouvertures de crochets. ou en appuyant sur le bouton # de l'éditeur de texte quand tu modifieras ton message ?

Ce serait bien plus lisible. :)

Quentin

D'accord

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
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

Citation:

Envoyé par joe.levrai

Bonjour,

et quelle est la question et/ou le problème ? Avec les détails associés (dans quel code, à quelle ligne ... quelle méthode/comportement tu n'arrives pas à gérer etc...)

balise également ton code, là c'est quelque peu "illisible"

J'aimerai parcourir et comparer les 2 fichiers joints

Dans le fichier test2.xlsx on a A001= P1+ P2+ P3= PLN + PJM +QUA ET DANS le fichier test.xlsx A001 =PLN;PJM;QUA

S'il trouve que A001 du fichier test2 = A001 du fichier test, il passe à la ligne suivante sinon il le met en couleur

Je trouve que mon code est lent et qu'il me colore tous les cellules.

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
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

Voici un code qui fonctionnerait parfaitement si tes codes Axxx et Bx étaient écrits de la même manière dans les deux fichiers
dans l'un, tu a par exemple A001 et dans l'autre c'est A1

j'ai corrigé manuellement et j'ai bien les Axxx de Test2 qui sont coloriés

donc c'est à toi de voir, au choix :

- corriger tes fichiers, car je soupçonne des problèmes futurs pour que la macro fonctionne correctement
- bricoler sur mon code pour détecter ces différences

A noter que je me suis permis d'ajouter dans la recherche la valeur de P4, s'il ne fallait pas tu me le dis et je modifie ça

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
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 Sh As Worksheet
Dim Tablo1
Dim Tablo2
 
Workbooks.Open ("W:\Entit\DIR IND\PA\GD\Habib\ONSAN\test.xlsx")
Set Sh = Workbooks("test.xlsx").Worksheets("Feuil1") 'feuille
With Sh
    Tablo1 = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With
 
Workbooks("test.xlsx").Close False
Workbooks.Open ("W:\Entit\DIRIND\PA\GD\Habib\ONSAN\test2.xlsx")
 
Set Sh = Workbooks("tests2.xlsx").Worksheets("Feuil1")
With Sh
    Tablo2 = .Range(.Cells(4, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With
 
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    For j = LBound(Tablo1, 1) To UBound(Tablo1, 1)
        If Tablo2(i, 1) = Tablo1(j, 2) Then
            If Tablo2(i, 5) & ";" & Tablo2(i, 4) & ";" & Tablo2(i, 8) & ";" & Tablo2(i, 9) = Tablo1(j, 3) Then
                Sh.Cells(i + 3, 1).Interior.Color = 27
                Exit For
            End If
        End If
    Next j
Next i
 
Set Sh = Nothing
 
Application.ScreenUpdating = True
 
End Sub

29/05/2015, 09h04
MacroVBA

Application en VBA

Bonjour Joe.levrai,
Merci pour ta reponse.
C'est exactement ce que je cherche mais neamoins sa ne marche pas avec mes fichiers.
Le but c'est de verifié que tous données (code et value) qui sont dans le fichier test se trouve dans test2 sans tenu compte des doublons qui sont dans tes2.
si le Axxx du test ne correspond pas au Axxx du test2, il colore le Axxx du test2
tu trouveras ci-joint le capture de mes 2 fichiers.
j'ai A= P1+P2+P3+P4 dans test2 et P1;P2;P3;P4 dans test

Merci d'avance
29/05/2015, 10h26
joe.levrai

Bonjour,

au temps pour moi, je pense avoir compris à l'envers

on est donc d'accord sur le fait que actuellement mon code :

- colorie les données identiques au lieu de faire l'inverse ?
- colorie la couleur de fond au lieu du texte ?
29/05/2015, 11h07
MacroVBA

Oui oui je suis d'accord

Merci de ton aide

j'ai juste inversé la condition qui vérifie si c'est identique, et appliqué la couleur au texte plutôt qu'au fond de cellule

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
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 Sh As Worksheet
Dim Tablo1
Dim Tablo2
 
Workbooks.Open ("W:\Entit\DIR IND\PA\GD\Habib\ONSAN\test.xlsx")
Set Sh = Workbooks("test.xlsx").Worksheets("Feuil1") 'feuille
With Sh
    Tablo1 = .Range(.Cells(2, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With
 
Workbooks("test.xlsx").Close False
Workbooks.Open ("W:\Entit\DIRIND\PA\GD\Habib\ONSAN\test2.xlsx")
 
Set Sh = Workbooks("tests2.xlsx").Worksheets("Feuil1")
With Sh
    Tablo2 = .Range(.Cells(4, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value
End With
 
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    For j = LBound(Tablo1, 1) To UBound(Tablo1, 1)
        If Tablo2(i, 1) = Tablo1(j, 2) Then
            If Tablo2(i, 5) & ";" & Tablo2(i, 4) & ";" & Tablo2(i, 8) & ";" & Tablo2(i, 9) <> Tablo1(j, 3) Then
                Sh.Cells(i + 3, 1).Font.Color = 27
                Exit For
            End If
        End If
    Next j
Next i
 
Set Sh = Nothing
 
Application.ScreenUpdating = True
 
End Sub