vba excel 將 2 列與第 3 列的條件進行比較

Question

在 sheet1 我有兩列：

在 Sheet2 我有一列：

在 Sheet3 中，我想得到以下結果：

Arguments 獲取 Sheet3 中的數據是：Sheet2 的 A 列的值等於 Sheet1 的 A 列的值（可以是隨機行#），如果等於，那么 Sheet1 的 B 列的值應該是“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 ，因此不要聲明兩者都設置它

3) Offset()是Range class 屬性，而 arrays 沒有方法也沒有屬性

要在二維數組的第二列中獲取一些值，請使用列索引，例如chk1(i, 2)

最后） sht3.Range("A" & lr3)會一遍又一遍地在同一個單元格中寫入

因此，要么你更新 lr3 （在End If之前有一些lr3 = lr3 + 1 ），要么你需要一個動態范圍引用總是指向sht3列最后一個非空單元之后的第一個空單元格，如sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Offset(1)

編輯：添加了不同的方法

提供（根據顯示的數據）Sheet1 的 B 列有“a”或空白單元格，那么您可以避免循環並使用Range object 的AutoFilter()和Specialcells()方法，如下所示（注釋中的解釋）：

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