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
122
123
124
125
126
127
128
129
130
131
| Sub ActualiserListe()
Dim i, a As Integer
Dim tableau() As String
Application.ScreenUpdating = False
nbligne = Sheets("BDD").Range("A1").End(xlDown).Row
ReDim tableau(nbligne - 1, 2)
i = 1
a = 0
For i = 1 To nbligne
Do While Sheets("BDD").Cells(i, 13).Value <> ActiveSheet.Range("A2").Value
i = i + 1
If i > nbligne Then
Exit Do
End If
Loop
If Sheets("BDD").Cells(i, 17).Value = "Retrait" Then
If IsDate(Sheets("BDD").Cells(i, 24)) And Sheets("BDD").Cells(i, 24) > Date Then
GoTo encore_ok
End If
i = i + 1
GoTo suivant
End If
encore_ok:
tableau(a, 0) = Sheets("BDD").Cells(i, 3).Value
tableau(a, 1) = Sheets("BDD").Cells(i, 4).Value
tableau(a, 2) = Sheets("BDD").Cells(i, 9).Value
a = a + 1
suivant:
Next i
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
If nbligne > 100000 Then
nbligne = 1
End If
For a = 0 To UBound(tableau)
If tableau(a, 0) = "" Then GoTo suite
var = Application.Match(tableau(a, 0), ActiveSheet.Columns(1), 0)
If IsError(var) Then
ActiveSheet.Cells(nbligne + 1, 1) = tableau(a, 0)
ActiveSheet.Cells(nbligne + 1, 2) = tableau(a, 1)
ActiveSheet.Cells(nbligne + 1, 3) = tableau(a, 2)
nbligne = nbligne + 1
End If
Next a
suite:
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
For a = 3 To nbligne
mon_tableau = tableau()
valeur_a_rechercher = ActiveSheet.Cells(a, 1)
If in_array(mon_tableau, valeur_a_rechercher) = False Then
If MsgBox("Le produit " & ActiveSheet.Cells(a, 1).Value & " n'apparait plus dans la base de données EPHY, voulez-vous le supprimer?", vbYesNo, "Demande de confirmation") = vbYes Then
ActiveSheet.Cells(a, 1).EntireRow.Delete
nbligne = nbligne - 1
End If
End If
Next a
nbligne = ActiveSheet.Range("A1").End(xlDown).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"A3:A" & nbligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A3:BZ" & nbligne)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3:BZ" & nbligne).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(LIGNE();2)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A3:BZ" & nbligne).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Application.ScreenUpdating = True
End Sub |
