VBA If And 多个条件

Question

谁能帮助解决我的编码问题？ If 语句需要三个单独的条件 = true，或者它检查下一个 if 语句并循环返回数组的所有单元格。没有错误，所以很难确定问题所在，而且我对 VBA 还很陌生，所以可能有更好的方法来完成这个。

注意：数组中所需的单元格不是静态的，因此查找。

    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

添加了一个额外的循环并分解了 if 逻辑以获得正确的 (?) 行为。

我得到这些结果...

...从这段代码...

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

根据您的代码和示例，我不清楚您何时希望在 Action2 中看到 "Manual Review"。显然，如果 References 匹配但 Amounts 不匹配；但由于这并未包含所有可能性，因此该部分代码有点 "sloppy"。在下面的代码中，所有不匹配的实例都将被标记为 "Manual Review"。如果确实如此，那么代码可以变得更简洁（更快）。

这是另一种方法，使用 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

这些是使用您最近发布的图片的结果：

VBA If And 多个条件

VBA If And multiple conditions

vba

excel

if-statement

multiple-conditions