VBA Excel сравнить 2 столбца с условием для 3-го столбца

Question

В листе 1 у меня есть два столбца:

В листе 2 у меня есть один столбец:

В Sheet3 я хочу получить следующий результат:

Аргументы для получения данных в Sheet3: Value столбца A Sheet2 равно значению в столбце A Sheet1 (может быть случайной строкой #) И если оно равно, значение в столбце B Sheet1 должно быть «a».

Я написал следующее:

Sub MatchColumnsCondition()

    Dim sht1, sht2, sht3 As Worksheet
    Dim lr1, lr2, lr3 As Long
    Dim chk1, chk2 As Variant
    Dim out3 As Range
    Dim dup As Boolean
    Dim i, j

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    lr1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
    lr2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row
    lr3 = sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Row

    Set chk1 = sht1.Range("A1:A" & lr1)
    Set chk2 = sht2.Range("A1:A" & lr2)
    Set out3 = sht3.Range("A1:A" & lr3)

    For i = LBound(chk1) To UBound(chk1)
           For j = LBound(chk2) To UBound(chk2)
            If chk1(i, 1) = chk2(j, 1) And chk1.Offset(, 1) = "a" Then
                sht3.Range("A" & lr3) = chk1(i, 1)
            End If
        Next j
    Next i

End Sub

но я продолжаю сталкиваться с ошибками, но я не знаю, как заставить его работать должным образом.

Answer 1

, чтобы остаться с вашим кодом

Sub MatchColumnsCondition()

    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Dim lr1 As Long, lr2 As Long
    Dim chk1 As Variant, chk2 As Variant
    Dim i As Long, j As Long

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    lr1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
    lr2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

     chk1 = sht1.Range("A1:B" & lr1).Value
     chk2 = sht2.Range("A1:A" & lr2).Value

    For i = LBound(chk1) To UBound(chk1)
           For j = LBound(chk2) To UBound(chk2)
            If chk1(i, 1) = chk2(j, 1) And chk1(i, 2) = "a" Then
                sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Offset(1).Value = chk1(i, 1)
            End If
        Next
    Next

End Sub

, где в исходном коде:

1) Dim sht1, sht2, sht3 As Worksheet

фактически приведет к:

Dim sht3 As Worksheet, sht1 As Variant, sht2 As Variant

, поскольку неявно объявленные переменные (Dim sht1, sht2, ...) будут неявно приняты как Variant тип

, следовательно, в явном виде объявляются все переменные Worksheet типа, например Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet

2) LBound(chk1) To UBound(chk1) и LBound(chk2) To UBound(chk2)

LBound() и UBound() функции принимают массив в качестве параметра.

Для того, чтобы иметь массив из Range вы должны взять его Value свойство

затем

• в порядке с Dim chk1, chk2 As Variant

, что приведет к Dim chk1 As Variant, chk2 As Variant и это нормально, поскольку Variant - это правильный тип, нам нужно сохранить значения диапазона в

• Set chk1 = sht1.Range("A1:A" & lr1) превращается в chk1 = sht1.Range("A1:B" & lr1).Value, поскольку вы не Set массив, и он вам нужен для хранения значений столбца B

• Set chk2 = sht2.Range("A1:A" & lr1) превращается в chk2 = sht2.Range("A1:A" & lr1).Value

• Вы не не нужно out3, следовательно, не объявляйте ни Set it

3) Offset() - это свойство класса Range, в то время как массивы не имеют ни методов, ни свойств

для получения некоторого значения во 2-м столбце двумерного массива, который вы используете индекс столбца, такой как chk1(i, 2)

наконец) sht3.Range("A" & lr3) будет продолжать писать в одну и ту же ячейку снова и снова

, следовательно, либо вы обновите lr3 (с некоторыми lr3 = lr3 + 1 до End If) или вам нужна динамическая ссылка на диапазон c, всегда указывающая на столбец sht3 Первая пустая ячейка после последней непустой, например sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Offset(1)

РЕДАКТИРОВАТЬ : добавлен другой подход * Если в 1085 *

столбце B листа Sheet1 (согласно показанным данным) есть либо ячейки "a", либо пустые ячейки, то можно избежать циклов и использовать методы AutoFilter() и Specialcells() объекта Range следующим образом ( пояснения в комментариях):

Sub MatchColumnsCondition2()

    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Dim chk2 As Variant

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    chk2 = sht2.Range("A1", sht2.Cells(sht2.Rows.Count, "A").End(xlUp)).Value

    With sht1 ' reference "sheet1"
        With .Range("B1:A" & .Cells(sht1.Rows.Count, "A").End(xlUp).Row) 'reference referenced sheet columns A:B range from row 1 down to column A last not empty cell row
            .Rows(1).EntireRow.Insert ' insert a "helper" row for headers
            With .Offset(-1).Resize(.Rows.Count + 1) ' reference referenced range plus added header row
                .Rows(1).Value = Array("h1", "h2") ' write dummy headers
                .AutoFilter field:=1, Criteria1:=Application.Transpose(chk2), Operator:=xlFilterValues ' filter referened range on its first column with sheet2 column A values
                .Resize(.Rows.Count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).SpecialCells(XlCellType.xlCellTypeConstants).Offset(, -1).Copy Destination:=sht3.Range("A1") ' copy referenced range second column filtered cells (skipping headers) with some constant value and paste to sheet 3 from cell A1
                .Rows(1).Delete xlUp ' delete "helper" row
            End With
       End With
    End With

End Sub