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 |
