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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
Sub PreparerLeBDC()
Dim wsBDC As Worksheet
Dim wsTarif As Worksheet
Dim wsRemises As Worksheet
Dim rngBDC As Range
Dim rngTarif As Range
Dim cell As Range
Dim lastRowBDC As Long
Dim i As Long
Dim Dict As Object
' Spécifiez le nom des onglets concernés
Set wsBDC = ThisWorkbook.Sheets("BDC PEBEO")
Set wsTarif = ThisWorkbook.Sheets("Tarif")
Set wsRemises = ThisWorkbook.Sheets("Remises")
Set Dict = CreateObject("Scripting.Dictionary")
' Détermine le nombre de lignes utilisées dans le BDC
lastRowBDC = 13 ' Initialise à la première ligne de données
Dim column As Range
Dim lastRow As Long
' Parcourt les colonnes de A à J
For Each column In wsBDC.Range("A:J").Columns
lastRow = column.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If lastRow > lastRowBDC Then
lastRowBDC = lastRow
End If
Next column
For i = 13 To lastRowBDC
If wsBDC.Cells(i, "A").Value <> "" Then
If Dict.exists(wsBDC.Cells(i, "A").Value) Then
Dict(wsBDC.Cells(i, "A").Value) = Dict(wsBDC.Cells(i, "A").Value) + 1
Else
Dict(wsBDC.Cells(i, "A").Value) = 1
End If
End If
Next i
For i = 13 To lastRowBDC
If wsBDC.Cells(i, "A").Value <> "" Then
If Dict(wsBDC.Cells(i, "A").Value) >= 2 Then
wsBDC.Range("A" & i & ":J" & i).Font.Bold = True
End If
End If
Next i
' Parcourt les lignes à partir de la ligne 13
For i = 13 To lastRowBDC
Set cell = wsBDC.Cells(i, "A")
' Vérifie si la cellule en colonne A contient une valeur
If cell.Value <> "" Then
' Vérifie si la cellule en colonne A est en fond vert pâle
If cell.Interior.Color = RGB(200, 255, 200) Then
' Recherche la valeur dans l'onglet "Tarif" colonnes A et B
Set rngTarif = wsTarif.Range("A:B")
Set cell = rngTarif.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cell Is Nothing Then
' Correspondance trouvée dans l'onglet "Tarif"
wsBDC.Cells(i, "C").NumberFormat = "@" ' Définit le format de la cellule comme texte
wsBDC.Cells(i, "C").Value = wsTarif.Cells(cell.Row, "B").Value ' Valeur en colonne B de l'onglet "Tarif"
wsBDC.Cells(i, "D").Value = wsTarif.Cells(cell.Row, "A").Value ' Valeur en colonne A de l'onglet "Tarif"
wsBDC.Cells(i, "E").Value = wsTarif.Cells(cell.Row, "D").Value ' Valeur en colonne D de l'onglet "Tarif"
wsBDC.Cells(i, "F").Value = wsTarif.Cells(cell.Row, "F").Value ' Valeur en colonne F de l'onglet "Tarif"
wsBDC.Cells(i, "G").Value = wsTarif.Cells(cell.Row, "G").Value ' Valeur en colonne F de l'onglet "Tarif"
' Vérifie si la colonne B a une valeur
If wsBDC.Cells(i, "B").Value <> "" And wsBDC.Cells(i, "B").Value <> 0 Then
' Vérifie si la quantité en colonne B est un multiple de la valeur en colonne F
If wsBDC.Cells(i, "B").Value Mod wsBDC.Cells(i, "F").Value <> 0 Then
' Remplace la valeur en colonne B par le multiple supérieur
Dim multiple As Double
multiple = Application.WorksheetFunction.Ceiling(wsBDC.Cells(i, "B").Value, wsBDC.Cells(i, "F").Value)
wsBDC.Cells(i, "B").Value = multiple
' Met la cellule en fond orange pâle
wsBDC.Cells(i, "B").Interior.Color = RGB(255, 230, 204)
Else
' Met la cellule en fond vert pâle
wsBDC.Cells(i, "B").Interior.Color = RGB(200, 255, 200)
End If
Else
' Met la cellule en fond rouge pâle
wsBDC.Cells(i, "B").Interior.Color = RGB(255, 230, 204)
wsBDC.Cells(i, "B").Value = wsBDC.Cells(i, "F").Value
End If
If wsBDC.Range("D7").Value = "Manuelle" Then
' Recherche la valeur de la colonne E dans la plage E1:E10 de l'onglet "Tarif"
Dim valueE As Variant
valueE = wsTarif.Cells(cell.Row, "E").Value
Dim rngD As Range
Set rngD = wsBDC.Range("E1:E10")
Set cell = rngD.Find(What:=valueE, LookIn:=xlValues, LookAt:=xlWhole)
' Vérifie si la valeur de la colonne E est trouvée dans la plage D1:D10
If Not cell Is Nothing Then
' Met la valeur de la cellule à sa droite dans la colonne H
wsBDC.Cells(i, "H").Value = cell.Offset(0, 2).Value
Else
' Met 0% dans la colonne H
wsBDC.Cells(i, "H").Value = 0
End If
Else
Dim formula As Variant
Dim bdcCellAddress As String
Dim bdcCellAddress2 As String
Dim remisesRangeAddress As String
Dim remisesRangeAddress2 As String
Dim tarifRangeAddress As String
bdcCellAddress = wsBDC.Cells(i, "B").Address(RowAbsolute:=False, ColumnAbsolute:=False)
bdcCellAddress2 = wsBDC.Cells(i, "C").Address(RowAbsolute:=False, ColumnAbsolute:=False)
remisesRangeAddress = "Remises!K:K"
remisesRangeAddress2 = "Remises!L:L"
tarifRangeAddress = "Tarif!B:E"
formula = "=MAX(SIERREUR(INDEX(Remises!H:H;EQUIV(1;(" & bdcCellAddress & ">=" & remisesRangeAddress & ")*(" & bdcCellAddress & "<=" & remisesRangeAddress2 & ")*(" & bdcCellAddress2 & "=Remises!G:G);0);2)/100;0%);" & _
"SIERREUR(RECHERCHEV(RECHERCHEV(" & bdcCellAddress2 & ";" & tarifRangeAddress & ";4;FAUX);'BDC PEBEO'!$E$2:$G$10;3;FAUX);0%))"
MsgBox formula
wsBDC.Cells(i, "H").FormulaArray = formula
If wsBDC.Cells(i, "H").Value > 1 Then
wsBDC.Cells(i, "H").Value = wsBDC.Evaluate(formula) / 100
wsBDC.Cells(i, "H").NumberFormat = "0.00%"
Else
wsBDC.Cells(i, "H").NumberFormat = "0.00%"
End If
End If
' Calcule la valeur de la colonne I : G*(1-H) arrondi à 2 chiffres après la virgule
Dim valueG As Double
Dim valueH As Double
valueG = wsBDC.Cells(i, "G").Value
valueH = wsBDC.Cells(i, "H").Value
wsBDC.Cells(i, "I").Value = Round(valueG * (1 - valueH), 2)
' Calcule la valeur de la colonne J : I*B
Dim valueI As Double
Dim valueF As Double
valueI = wsBDC.Cells(i, "I").Value
valueF = wsBDC.Cells(i, "B").Value
wsBDC.Cells(i, "J").Value = valueI * valueF
End If
End If
End If
Next i
' Supprimer le formatage conditionnel dans les colonnes C à J
wsBDC.Range("C13:J" & lastRowBDC).Interior.ColorIndex = xlColorIndexNone
wsBDC.Cells.FormatConditions.Delete
' Centre le contenu des colonnes A, C, E, G et H
wsBDC.Range("A13:J" & lastRowBDC).HorizontalAlignment = xlCenter
' Aligne le contenu de la colonne E à gauche
wsBDC.Range("E13:E" & lastRowBDC).HorizontalAlignment = xlLeft
' Formate la colonne D en tant que Nombre
wsBDC.Range("D13:D" & lastRowBDC).NumberFormat = "0"
' Formate la colonne G en tant que valeurs monétaires en euros
wsBDC.Range("G13:J" & lastRowBDC).NumberFormat = "#,##0.00 €"
' Formate la colonne H en tant que %
wsBDC.Range("H13:H" & lastRowBDC).NumberFormat = "0.00%"
' Vérifie si au moins une cellule en orange ou en rouge pâle est présente dans la colonne F
Dim hasError As Boolean
hasError = False
For i = 13 To lastRowBDC
If wsBDC.Cells(i, "A").Interior.Color = RGB(255, 192, 203) Then
wsBDC.Range("B" & i & ":J" & i).ClearContents
wsBDC.Range("B" & i & ":J" & i).ClearFormats
End If
If wsBDC.Cells(i, "B").Interior.Color = RGB(255, 230, 204) Or wsBDC.Cells(i, "B").Interior.Color = RGB(255, 192, 203) Then
hasError = True
Exit For
End If
Next i
' Affiche le message d'erreur si nécessaire
If hasError Then
MsgBox "Les quantités doivent être un multiple du PCB. Les quantités en orange ont été corrigées. "
End If
End Sub |
Formule VBA - Erreur 400 incompréhensible
Répondre avec citation
Partager