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
| Option Explicit
Sub Synthèse()
Dim u, v, Cel As Range
Dim dico1 As Object, dico2 As Object
Dim i As Long, j As Long, lgn As Long, k As Long
Sheets("Synthèse").Select
Range("A2:CF" & Rows.Count).Clear
Application.ScreenUpdating = False
u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
Set dico1 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(u, 1)
dico1(u(i, 11)) = i
Next i
Set dico2 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v, 1)
dico2(v(i, 11)) = i
Next i
lgn = 1
For i = 1 To UBound(u, 1)
'recopie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
If dico2.exists(u(i, 11)) = False Then
Debug.Print "Ajout de 1: " & u(i, 11)
lgn = lgn + 1
For j = 1 To UBound(u, 2)
Sheets("Synthèse").Cells(lgn, j) = u(i, j)
Next j
End If
Next i
For i = 1 To UBound(v, 1)
If v(i, 11) <> "" Then '--- contient un ID
lgn = lgn + 1
If dico1.exists(v(i, 11)) Then
k = dico1(v(i, 11)) '--- n° ligne dans feuil1
Debug.Print u(k, 11) & "<>" & v(i, 11), dico1(v(i, 11)) & "<>" & dico2(v(i, 11))
'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(i, j)
If u(k, j) <> v(i, j) Then
Debug.Print "-- " & u(k, j) & " --> " & v(i, j)
Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If
Next j
Else
'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
Debug.Print "Ajout de 2: " & v(i, 11)
For j = 1 To UBound(v, 2)
Sheets("Synthèse").Cells(lgn, j) = v(i, j)
Next j
End If
End If
Next i
Application.ScreenUpdating = True
End Sub |
