VBA If и несколько условий

Может ли кто-нибудь помочь в устранении неполадок моего кодирования? Оператор 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

ОБНОВЛЕННЫЙ ОБРАЗ

2 ответа

  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
    
  2. Мне не ясно из вашего кода и вашего примера, когда вы хотите увидеть «ручной обзор» в Action2. Очевидно, если ссылки совпадают, но суммы не совпадают; но поскольку это не охватывает все возможности, эта часть кода немного «небрежна». В приведенном ниже коде все экземпляры, где нет совпадения, будут помечены как «просмотр вручную». Если это действительно так, то код можно сделать немного чище (и быстрее).

    Вот еще один способ сделать это, используя 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
    

    Это результаты использования вашего последнего опубликованного изображения:

    Введите описание изображения здесь