vba - 无法创建循环来比较两个工作表的内容

Question

我编写了一个脚本，该脚本应该比较工作簿中两张工作表之间 A 列的内容，以找出是否存在部分匹配。更清楚地说:如果工作表 1 中的列 A 中的任何单元格的任何内容与工作表 2 中的列 A 中的任何单元格的任何内容匹配，那么这将是匹配项，脚本将在立即窗口中打印该匹配项。 p>

这是我迄今为止的尝试:

Sub GetPartialMatch()
    Dim paramlist As Range

    Set paramlist = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

    For Each cel In Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If InStr(1, cel(1, 1), paramlist, 1) > 0 Then  'I used "paramlist" here as a placeholder as I can't use it
           Debug.Print cel(1, 1)
        End If
    Next cel
End Sub

问题是我无法使用脚本中定义的paramlist。我只是将它用作占位符。

Answer 1

使用数组和 Application.Match() 函数提供了一种非常快速的方法:

Sub GetPartialMatch()
    Dim paramlist1 As Variant, paramlist2 As Variant
    Dim cel As Range
    Dim i As Long

    paramlist1 = Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(1) column A values in an array
    paramlist2 = Sheets(2).Range("A2", Sheets(2).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(2) column A values in an array

    For i = 1 To UBound(paramlist1) ' loop through paramlist1 array row index
        If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 1)) Then Debug.Print paramlist1(i, 1) ' if partial match between current paramlist1 value and any paramlist2 value, then print it
    Next
End Sub

如果您想要精确匹配，只需在 Match() 函数中使用 0 作为最后一个参数，即:

If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 0)) Then Debug.Print paramlist1(i, 1) ' if exact match between current paramlist1 value and any paramlist2 value, then print it

顺便说一句，如果您需要精确匹配，您还可以使用 Range 对象的 Autofilter() 方法，并将 xlFilterValues 作为其 运算符参数:

Sub GetPartialMatch2()
    Dim paramlist As Variant
    Dim cel As Range

    paramlist = Application.Transpose(Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value) ' collect all sheets(1) column A values in an array

    With Sheets(2).Range("A1", Sheets(2).Cells(Rows.Count, 1).End(xlUp)) ' reference sheets(2) column A cells from row 1 (header) down to last not empty one
        .AutoFilter field:=1, Criteria1:=paramlist, Operator:=xlFilterValues ' filter referenced range with 'paramlist'
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then header
            For Each cel In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' loop through all sheets(2) filtered cells but the header
                Debug.Print cel.Value2
            Next
        End If
        .Parent.AutoFilterMode = False 'remove filter
    End With
End Sub