Formule VBA - Erreur 400 incompréhensible

**Znooper** · 08/06/2023, 09h53

Bonjour à tous,

Bien que ce forum m'ait été d'une très grande aide jusque-là, je me heurte à une erreur 400 dans une macro, que je ne parviens pas à résoudre, peu importe ce que j'essaye.

Cette erreur survient lorsque j'essaye d'exécuter une formule matricielle.

Pouvez-vous m'aider ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

De ce que j'en comprends, l'erreur se produit lors de :

wsBDC.Cells(i, "H").FormulaArray = formula

Mais je peux me tromper.

À noter: lorsque je saisis la même formule manuellement dans la cellule, celà fonctionne.

J'espère que vous aurez la solution à mon problème,

Merci par avance,

Maxime

**BENNASR** · 08/06/2023, 10h22

Bonjour
ce n'est qu'une tentative d'un autodidacte ... méfiez de mes propos

Vous pouvez alléger le code et quand vous cherchez la dernière ligne non vide d'une feuille
il suffit de faire avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 derlig = F1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row

et si vous cherchez la dernière la dernière ligne que dans les trois première colonne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

derlig = F1.Range(F1.Columns(1), F1.Columns(3)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row

pour copier une formule dans une colonne je fais avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Const laformule As String = "=a2*b2"
lrow = Sheets("TEST1").Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("TEST1").Range("C2:C" & lrow)
          .FormulaLocal = laformule
       ' pour copier que la valeur sans la formule
        .Value = .Value
 End With

**Znooper** · 08/06/2023, 14h13

Envoyé par BENNASR

pour copier une formule dans une colonne je fais avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Const laformule As String = "=a2*b2"
lrow = Sheets("TEST1").Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("TEST1").Range("C2:C" & lrow)
          .FormulaLocal = laformule
       ' pour copier que la valeur sans la formule
        .Value = .Value
 End With

Le souci étant que ma formule matricielle contient des variables, et que celà semble être source d'erreur avec la solution proposée.

**Znooper** · 08/06/2023, 14h32

En réponse à moi-même parce que je viens de résoudre le problème, la solution ressemble à ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 Dim formula As Variant
 
                    formula = "=MAX(IFERROR(INDEX(Remises!C,MATCH(1,(RC[-6]>=Remises!C[3])*(RC[-6]<=Remises!C[4])*(RC[-5]=Remises!C[-1]),0),1)/100,0%),IFERROR(VLOOKUP(VLOOKUP(RC[-5],Tarif!C[-6]:C[-3],4,FALSE),'BDC PEBEO'!R2C5:R10C7,3,FALSE),0%))"
 
                    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

En revanche, celà semble être plutôt long à exécuter en volume. Avez-vous des pistes pour améliorer ce point ?

**umfred** · 08/06/2023, 16h26

Juste au cas où, ton problème d'origine, c'est que Formula ou FormulaArray ne "comprennent" que les formules écrites en version US et avec la virgule en séparateur à la place du point virgule (FormulaLocal comprend les formules dans le langage courant d'Excel, mais il y a pas de version Local pour FormulaArray)) Il faut "juste" traduire le nom des fonctions excel de la formule.

Pour le temps aucune idée, mais si l'opération se fait une certaine quantité de cellules, alors ce n'est pas vraiment anormal.

**Znooper** · 08/06/2023, 17h22

En l'état, mon problème n'était pas résolu, celà fonctionne en procédant comme celà :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
 
 Dim formula As Variant
                    Dim formulab As Variant
                    Dim resultb As Range
 
 
                    formulab = "=IFERROR(INDEX('Remises'!C,MATCH(1,(RC[-6]>='Remises'!C11)*(RC[-6]<='Remises'!C12)*(RC[-5]='Remises'!C7),0),1),0%)"
                    Set resultb = Cells(i, "H")
                    resultb.FormulaArray = formulab
 
                    If resultb > 1 Then
                    formula = "=MAX(IFERROR(INDEX('Remises'!C,MATCH(1,(RC[-6]>='Remises'!C[3])*(RC[-6]<='Remises'!C[4])*(RC[-5]='Remises'!C[-1]),0),1)/100,0%),IFERROR(VLOOKUP(VLOOKUP(RC[-5],Tarif!C[-6]:C[-3],4,FALSE),'BDC PEBEO'!R2C5:R10C7,3,FALSE),0%))"
                    Else
                    formula = "=MAX(IFERROR(INDEX('Remises'!C,MATCH(1,(RC[-6]>='Remises'!C[3])*(RC[-6]<='Remises'!C[4])*(RC[-5]='Remises'!C[-1]),0),1),0%),IFERROR(VLOOKUP(VLOOKUP(RC[-5],Tarif!C[-6]:C[-3],4,FALSE),'BDC PEBEO'!R2C5:R10C7,3,FALSE),0%))"
                    End If
 
                    wsBDC.Cells(i, "H").FormulaArray = formula

Formule VBA - Erreur 400 incompréhensible

Macros et VBA Excel

Discussions similaires

Partager

Partager