excel - 检查所有列值是否存在于另一个列表中

Question

我创建的 excel vba 宏遍历整个列，并针对在另一个工作表上找到的另一列搜索列中的每个值。我有一个 T/F 列，如果找到，则标记为“T”，如果找不到，则标记为“F”。但是，我觉得我这样做的方式可能不是很有效，因为宏需要大约 30 分钟才能通过大约 27,000 个值的另一列搜索 31,000 行值。

为了简单说明，我包含了一些解释宏功能的图像。



最初，T/F 列将为空。只有在执行宏之后，它才会被填充。我遍历 A 列中的每一行，并尝试在下一张图片中找到针对 SearchCol 的值。



这是我目前正在使用的 vba 代码。

Sub CheckIfValuesExist()
    Dim ActiveWS As Worksheet, WS2 As Worksheet
    Dim ValueColLetter As String, SearchColLetter As String, TFColLetter As String
    Dim LastRow As Long, i As Long
    Dim target As Variant, rng As Range

    Set ActiveWS = ActiveWorkbook.Worksheets(1)
    Set WS2 = ActiveWorkbook.Worksheets(2)
    ValueColLetter = "A"
    SearchColLetter = "A"
    TFColLetter = "B"
    LastRow = ActiveWS.Cells.Find(What:="*", SearchOrder:=xlRows, _
               SearchDirection:=xlPrevious, _
               LookIn:=xlFormulas).Row

    For i = 2 To LastRow
        target = ActiveWS.Range(ValueColLetter & i).Value
        If target <> "" Then
            With WS2.Range(SearchColLetter & ":" & SearchColLetter) 'searches all of column A
                Set rng = .Find(What:=target, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not rng Is Nothing Then
                    ActiveWS.Range(TFColLetter & i).Value = "T" 'value found
                Else
                    ActiveWS.Range(TFColLetter & i).Value = "F" 'value not found
                End If
            End With
        End If
    Next i
End Sub

宏按预期工作，我只是觉得它很慢。有没有更好的方法来做同样的事情，但以更快的方式？

Answer 1

检查列对列

数组匹配范围版本

Sub CheckIfValuesExist()

    Const cSheet1 As Variant = 1  ' Value Worksheet Name/Index
    Const cSheet2 As Variant = 2  ' Search Worksheet Name/Index
    Const cFirst As Long = 2      ' First Row
    Const cVal As Variant = "A"   ' Value Column
    Const cSrc As Variant = "A"   ' Search Column
    Const cTF As Variant = "B"    ' Target Column
    Const cT As String = "T"      ' Found String
    Const cF As String = "F"      ' Not Found String

    Dim RngS As Range     ' Search Range
    Dim vntV As Variant   ' Value Array
    Dim vntT As Variant   ' Target Array
    Dim LastV As Long     ' Value Last Column Number
    Dim LastS As Long     ' Search Last Column Number
    Dim i As Long         ' Value/Target Row Counter
    Dim dummy As Long     ' Match Dummy Variable

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    On Error GoTo ProcedureExit

    With ThisWorkbook.Worksheets(cSheet1)
        LastV = .Columns(.Cells(1, cVal).Column).Find("*", , -4123, , 2, 2).Row
        vntV = .Range(.Cells(cFirst, cVal), .Cells(LastV, cVal))
    End With

    With ThisWorkbook.Worksheets(cSheet2)
        LastS = .Columns(.Cells(1, cSrc).Column).Find("*", , -4123, , 2, 2).Row
        Set RngS = .Range(.Cells(cFirst, cSrc), .Cells(LastS, cSrc))
        ReDim vntT(1 To UBound(vntV), 1 To 1)
        For i = 1 To UBound(vntV)
            On Error Resume Next
            If vntV(i, 1) <> "" Then
                dummy = Application.Match(vntV(i, 1), RngS, 0)
                If Err Then
                    vntT(i, 1) = cF
                  Else
                    vntT(i, 1) = cT
                End If
            End If
            On Error GoTo 0
        Next
    End With

    On Error GoTo ProcedureExit

    With ThisWorkbook.Worksheets(cSheet1)
        .Range(.Cells(cFirst, cTF), .Cells(.Rows.Count, cTF)).ClearContents
        .Cells(cFirst, cTF).Resize(UBound(vntT)) = vntT
    End With

ProcedureExit:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub