VBA If Et plusieurs conditions

Question

Quelqu'un pourrait-il aider à résoudre mon problème de codage? L'instruction If requiert trois conditions séparées = true ou vérifie l'instruction if suivante et boucle pour toutes les cellules du tableau. Il n'y a pas d'erreur donc il est difficile de déterminer le problème, en plus je suis très nouveau à VBA donc il y a probablement une meilleure façon d'y parvenir.

Remarque: Les cellules nécessaires dans les tableaux ne sont pas statiques, d'où le résultat.

Sub test() 
Dim i As Integer 
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range 
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant 

Set col1 = ActiveSheet.Cells.find("Reference", , xlValues, xlWhole) 
Set col2 = ActiveSheet.Cells.find("Amount", , xlValues, xlWhole) 
Set col3 = ActiveSheet.Cells.find("Action", , xlValues, xlWhole) 
Set col4 = ActiveSheet.Cells.find("Reference2", , xlValues, xlWhole) 
Set col5 = ActiveSheet.Cells.find("Amount2", , xlValues, xlWhole) 
Set col6 = ActiveSheet.Cells.find("Action2", , xlValues, xlWhole) 

lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row 

c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value 
c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value 
c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value 
c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value 
c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value 
c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value 

For i = 1 To UBound(c1arr) 
    If c2arr(i, 1) > 0 And c1arr(i, 1) = c4arr(i, 1) And c2arr(i, 1) = c5arr(i, 1) Then 
      c6arr(i, 1) = c3arr(i, 1) 
    ElseIf c2arr(i, 1) > 0 And c1arr(i, 1) <> c4arr(i, 1) And c2arr(i, 1) <> c5arr(i, 1) Then 
      c6arr(i, 1) = "Manual Review" 
    End If 
Next 

Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr 
End Sub 

UPDATED IMAGE

Answer 1

Ajout d'une boucle supplémentaire et rompu la logique si pour obtenir le comportement correct (?).

Je reçois ces résultats ...

... à partir de ce code ...

Sub test() 
Dim i As Integer, j As Integer, lastrow As Long 
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range 
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant 

    Set col1 = ActiveSheet.Cells.Find("Reference", , xlValues, xlWhole) 
    Set col2 = ActiveSheet.Cells.Find("Amount", , xlValues, xlWhole) 
    Set col3 = ActiveSheet.Cells.Find("Action", , xlValues, xlWhole) 
    Set col4 = ActiveSheet.Cells.Find("Reference2", , xlValues, xlWhole) 
    Set col5 = ActiveSheet.Cells.Find("Amount2", , xlValues, xlWhole) 
    Set col6 = ActiveSheet.Cells.Find("Action2", , xlValues, xlWhole) 

    lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row 

    c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value 
    c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value 
    c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value 

    lastrow = Cells(Rows.Count, col4.Column).End(xlUp).Row 

    c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value 
    c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value 
    c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value 

    For i = 1 To UBound(c4arr) 
     If c6arr(i, 1) = "" Then ' if already determined an answer, don't try again 
      For j = 1 To UBound(c1arr) 
       If c1arr(j, 1) = c4arr(i, 1) Then ' found Reference2 within Reference 
        If c2arr(j, 1) = c5arr(i, 1) And c2arr(j, 1) > 0 Then 
         c6arr(i, 1) = c3arr(j, 1) 
        Else 
         c6arr(i, 1) = "Manual Review" 
        End If 
       End If 
      Next j 
     End If 
     If c6arr(i, 1) = "" Then ' if haven't found an answer yet, it needs review 
      c6arr(i, 1) = "Manual Review" 
     End If 
    Next i 

    Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr 

End Sub 

Answer 2

Il est clair pour moi, à partir de votre code et votre exemple, lorsque vous voulez voir "Revue manuelle" dans Action2. Évidemment, si les références correspondent mais pas les montants; mais puisque cela n'inclut pas toutes les possibilités, cette partie du code est un peu "bâclée". Dans le code ci-dessous, tous les cas où il n'y a pas de correspondance seront marqués "Revue manuelle". Si c'est vraiment le cas, alors le code pourrait être rendu un peu plus propre (et plus rapide).

Voici une autre façon de procéder en utilisant WorksheetFunction.Match.

Option Explicit 
    Sub test() 
Dim i As Integer, lastrow As Long, J As Long 
Dim col1 As Range, col2 As Range, col3 As Range, col4 As Range, col5 As Range, col6 As Range 
Dim c1arr, c2arr, c3arr, c4arr, c5arr, c6arr As Variant 


Set col1 = ActiveSheet.Cells.Find("Reference", , xlValues, xlWhole) 
Set col2 = ActiveSheet.Cells.Find("Amount", , xlValues, xlWhole) 
Set col3 = ActiveSheet.Cells.Find("Action", , xlValues, xlWhole) 
Set col4 = ActiveSheet.Cells.Find("Reference2", , xlValues, xlWhole) 
Set col5 = ActiveSheet.Cells.Find("Amount2", , xlValues, xlWhole) 
Set col6 = ActiveSheet.Cells.Find("Action2", , xlValues, xlWhole) 

lastrow = Cells(Rows.Count, col1.Column).End(xlUp).Row 

c1arr = Range(Cells(2, col1.Column), Cells(lastrow, col1.Column)).Value 
c2arr = Range(Cells(2, col2.Column), Cells(lastrow, col2.Column)).Value 
c3arr = Range(Cells(2, col3.Column), Cells(lastrow, col3.Column)).Value 
c4arr = Range(Cells(2, col4.Column), Cells(lastrow, col4.Column)).Value 
c5arr = Range(Cells(2, col5.Column), Cells(lastrow, col5.Column)).Value 
c6arr = Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value 

'Clear c6arr 
ReDim c6arr(1 To UBound(c6arr, 1), 1 To 1) 

For i = 1 To UBound(c1arr) 
    If c2arr(i, 1) > 0 Then 
     On Error Resume Next 
      J = WorksheetFunction.Match(c1arr(i, 1), c4arr, 0) 
      If Err.Number = 0 Then 
       If c2arr(i, 1) = c5arr(J, 1) Then 
        c6arr(J, 1) = c3arr(i, 1) 
       Else 
        c6arr(J, 1) = "Manual Review" 
       End If 
      End If 
     On Error GoTo 0 
    End If 
Next i 

'Fill the blanks 
For i = 1 To UBound(c6arr, 1) 
    If c6arr(i, 1) = "" Then c6arr(i, 1) = "Manual Review" 
Next i 

Range(Cells(2, col6.Column), Cells(lastrow, col6.Column)).Value = c6arr 
End Sub 

Ce sont les résultats en utilisant votre dernière image affichée: