[excel实战]处理大量匹配数据?别用VLOOKUP了,这个VBA脚本更实在

前几天有个朋友问我，Excel里有一个大表（Sheet1），里面几万条数据；另外还有一个只有几百个GUID的清单（Sheet2），想把这个清单里对应的数据从大表里提取出来，弄到Sheet3。

（大白话就是：根据sheet2的中的某一列数据，匹配出sheet1中的数据，放到sheet3中）

如下图：

这事儿要是用VLOOKUP，几万行数据一拉，电脑能卡死；要是手动筛选复制，几百条数据能把自己累死。 分享一段我平时用的VBA代码，专门解决这种问题的。

它好在哪？

1. 快：利用字典做索引，不管几万行还是几十万行，跑起来基本就是几秒的事。
2. 不抢剪贴板：很多VBA代码运行时你不能复制别的东西，因为它用到了系统剪贴板。这段代码完全在内存里操作，你一边跑代码一边聊微信复制文字互不影响。
3. 不用太操心格式：代码会自动判断你的Sheet2有没有标题行，提取结果会自动带上表头。

代码直接用

Alt + F11 打开VBA编辑器，插入模块，把下面代码贴进去。

 记得修改代码开头的 Sheets("Sheet1/2/3") 改成你自己实际的工作表名字。

Sub CopyDataByGUIDWithHeaders_NoClipboard()
    Dim wsSource As Worksheet
    Dim wsCriteria As Worksheet
    Dim wsTarget As Worksheet

    Dim lastRowSource As Long
    Dim lastRowCriteria As Long
    Dim lastRowTarget As Long

    Dim targetRow As Long
    Dim i As Long
    Dim startRow As Long
    Dim guidValue As String
    Dim dict As Object
    Dim sourceArr As Variant
    Dim targetArr As Variant
    Dim colCount As Long

    ' 设置工作表，这里改成你自己的Sheet名称
    Set wsSource = ThisWorkbook.Sheets("Sheet1")   ' 数据源
    Set wsCriteria = ThisWorkbook.Sheets("Sheet2") ' GUID清单
    Set wsTarget = ThisWorkbook.Sheets("Sheet3")   ' 结果放这

    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' 忽略大小写

    ' 读取Sheet2的GUID清单
    lastRowCriteria = wsCriteria.Cells(wsCriteria.Rows.Count, 1).End(xlUp).Row

    ' 自动判断Sheet2第一行是不是标题（如果是"GUID"或者字数特别多，就当它是标题）
    If InStr(1, UCase(wsCriteria.Cells(1, 1).Value), "GUID", vbTextCompare) > 0 Or _
        Len(wsCriteria.Cells(1, 1).Value) > 30 Then
        startRow = 2
    Else
        startRow = 1
    End If

    ' 把Sheet2的GUID全部装进字典里，建立索引
    For i = startRow To lastRowCriteria
        DoEvents
        If Not IsEmpty(wsCriteria.Cells(i, 1).Value) Then
            dict(CStr(wsCriteria.Cells(i, 1).Value)) = True
        End If
    Next i

    ' 关闭屏幕刷新，提速
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' 获取源表数据范围
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    colCount = wsSource.UsedRange.Columns.Count

    ' 把Sheet1数据一次性读入内存，不操作单元格，这是速度快的关键
    sourceArr = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, colCount)).Value

    ' 清空Sheet3
    wsTarget.Cells.ClearContents

    ' 把表头写进去
    wsTarget.Range(wsTarget.Cells(1, 1), wsTarget.Cells(1, colCount)).Value = Application.Index(sourceArr, 1, 0)

    targetRow = 2
    ReDim targetArr(1 To lastRowSource, 1 To colCount)

    ' 开始匹配
    For i = 2 To UBound(sourceArr)
        guidValue = CStr(sourceArr(i, 1))
        If dict.Exists(guidValue) Then
            ' 命中后，整行数据丢进临时数组
            For j = 1 To colCount
                targetArr(targetRow - 1, j) = sourceArr(i, j)
            Next j
            targetRow = targetRow + 1
        End If
    Next i

    ' 内存里的数据一次性写回Sheet3
    If targetRow > 2 Then
        wsTarget.Range(wsTarget.Cells(2, 1), wsTarget.Cells(targetRow - 1, colCount)).Value = targetArr
    End If

    ' 恢复设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    MsgBox "搞定，共提取了 " & targetRow - 2 & " 条记录到Sheet3"
End Sub

简单说下原理

这段代码之所以快，主要做了两件事：

1. 字典查找：它没有用一个个去循环比对，而是先把Sheet2的GUID做成一个“字典索引”。查找的时候就像查字典一样，瞬间就知道有没有，不用一行行去翻。
2. 内存数组：它没有一行行去复制粘贴单元格，而是先把整个Sheet1的数据读到内存（数组）里，处理完再一次性吐到Sheet3。减少了对Excel单元格的操作次数，速度自然就上去了。 只要确保你的GUID都在第1列（A列），其他的基本不用管。希望能帮被数据折磨的朋友省点时间。

为了能随时获取最新动态，大家可以动动小手将公众号添加到“星标⭐”哦，点赞 + 关注，用时不迷路！！！！

关注公众号：IT小本本 👇