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
|
Sub test()
Dim Init As Boolean
Dim WsAvant As Worksheet
Dim WSApres As Worksheet
Dim WsActif As Workbook
Dim C As Long
Dim L As Long
Dim L2 As Long
Dim newWs As Worksheet
Dim R As Range
'Récupère les information utiles.
Set WbActif = ActiveWorkbook
Set WsAvant = WbActif.Worksheets("ancienne extraction")
Set WSApres = WbActif.Worksheets("Nouvelle extraction ")
Set newWs = WbActif.Worksheets.Add(After:=WbActif.Worksheets(WbActif.Worksheets.Count))
newWs.Name = Format(Date, "yyyy-mm-dd")
L = 1
newWs.Cells(L, 1) = "Avant"
L = L + 1
For C = 1 To WsAvant.UsedRange.Columns.Count
newWs.Cells(L, C) = WsAvant.Cells(1, C)
MyColor newWs.Cells(L, C)
Next
Set R = WSApres.UsedRange
For L2 = 2 To R.Rows.Count
Highlander Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))
Next
Set R = WsAvant.UsedRange
For L2 = 2 To R.Rows.Count
If Highlander(Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))) = False Then
L = L + 1
For C = 1 To R.Columns.Count
newWs.Cells(L, C) = R(L2, C)
Next
End If
Next
Init = False
For L2 = 2 To R.Rows.Count
Highlander Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))
Next
L = L + 1
newWs.Cells(L, 1) = "Après"
L = L + 1
For C = 1 To WsAvant.UsedRange.Columns.Count
newWs.Cells(L, C) = WsAvant.Cells(1, C)
MyColor newWs.Cells(L, C)
Next
Set R = WSApres.UsedRange
For L2 = 2 To R.Rows.Count
If Highlander(Init, R.Range(R(L2, 1), R(L2, R.Columns.Count))) = False Then
L = L + 1
For C = 1 To R.Columns.Count
newWs.Cells(L, C) = R(L2, C)
Next
End If
Next
Set WbActif = Nothing
Set WsAvant = Nothing
Set WSApres = Nothing
Set newWs = Nothing
MsgBox "Fin "
End Sub
Sub MyColor(R As Range)
Range("A2").Select
With R.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End Sub
Function Highlander(Init, ParamArray Plage())
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
Static CollectDoublon
Dim t
Dim PlageIndex
Dim myPlage As Range
Dim Col As Integer
Dim Tableau
If Init = False Then
Init = True
Set CollectDoublon = Nothing
Set CollectDoublon = CreateObject("scripting.dictionary")
End If
t = "T"
For PlageIndex = 0 To UBound(Plage)
If TypeName(Plage(PlageIndex)) = "Range" Then
Set myPlage = Plage(PlageIndex)
For Col = 1 To myPlage.Columns.Count
Debug.Print Trim("" & myPlage(1, Col))
'myPlage(1, Col).Select
t = t & "_" & Trim("" & myPlage(1, Col))
Next
Else
If TypeName(Plage(PlageIndex)) = "Variant()" Then
Tableau = Plage(PlageIndex)
Else
If TypeName(Plage(PlageIndex)) Like "*()" Then
Tableau = Plage(PlageIndex)
Else
Tableau = Split(Plage(PlageIndex) & ";", ";")
End If
End If
For Col = 0 To UBound(Tableau)
t = t & "_" & Trim("" & Tableau(Col))
Next
End If
Next
Highlander = CollectDoublon.exists(Trim("" & t))
CollectDoublon(Trim("" & t)) = Trim("" & t)
End Function |
