excel - 在更大的数据集中搜索和查找值的快速方法 - VBA

Question

我有两列包含字母数字数据 - workbook1 中的 A 列和 workbook2 中的 A 列。
工作簿 1 中的 A 列包含 40,000 行(包含重复值，但它们是必需的)，工作簿 2 中的 A 列包含 25,000 行(包含唯一值)。我必须搜索 B 列中是否存在 A 列值。如果是，我必须将工作簿 1 中的 B 列更新为 user_found。
我尝试循环，但由于数据量很大，Excel 经常崩溃并且需要很长时间。请帮助我是初学者。

    Dim arr As Variant

    With AAws1
    arr = AAws1.Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    End With

    Dim varr As Variant

    With userws1
    varr = userws1.Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    End With

    m = 4
    Dim x, y, match As Boolean
    For Each x In arr
        match = False
        For Each y In varr
            If x = y Then
            match = True
            AAws1.Cells(m, 4).Value = "user found"
           End If
'           m = m + 1
        Next y

        If Not match Then
            AAws1.Cells(m, 4).Value = "Not found"
        End If
        m = m + 1
    Next
  

Answer 1

标记找到的值

这将创建对包含唯一值的源查找列范围 (srg) 的引用，并将此范围用作 Application.Match 中的第二个参数因为它在范围上的效率是数组上的几倍。目标查找列范围 ( drg ) 中的值将写入数组 ( dData )，该数组也将用作结果数组 ( dData )。将结果写入数组 ( dData ) 后，其值将复制到给定列 ( dCol )，即复制到目标范围 ( drg.EntireRow.Columns(dCol) )。

Option Explicit

Sub FlagUnique()
    
    Const dCol As String = "B"
    Const dFlag As String = "user found"
    
    ' Source - unique
    Dim srg As Range
    With userws1
        ' 'Application.Match' is multiple times faster on a range
        ' than on an array.
        Set srg = .Range("A4", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    ' Destination - duplicate
    Dim drg As Range
    Dim dData As Variant
    With AAws1
        Set drg = .Range("A4", .Range("A" & .Rows.Count).End(xlUp))
        dData = drg.Value
    End With

    Dim dValue As Variant
    Dim sIndex As Variant
    Dim r As Long
    Dim IsFound As Boolean
    
    For r = 1 To UBound(dData)
        dValue = dData(r, 1)
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then
                sIndex = Application.Match(dValue, srg, 0)
                If IsNumeric(sIndex) Then
                    dData(r, 1) = dFlag
                    IsFound = True
                End If
            End If
        End If
        If IsFound Then
            IsFound = False
        Else
            dData(r, 1) = "not found" ' I would prefer 'dData(r, 1) = Empty'
        End If
    Next r
    
    drg.EntireRow.Columns(dCol).Value = dData

End Sub