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”。如果确实如此，则可以使代码更清晰（更快）。

以下是使用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如果和多个条件

2 个答案: