在当今的数据处理领域，Excel作为一款强大的电子表格软件，被广泛应用于各种数据处理和分析任务中。然而，面对大规模的数据集和复杂的匹配需求，手动操作往往显得力不从心。为了解决这个问题，本文介绍了一款基于VBA（Visual Basic for Applications）的Excel工作表数据匹配与合并宏。

表之间数据合并界面

该宏通过VBA编程实现了自动化的数据处理流程，包括工作表下拉框的填充、列的选择、数据的匹配与合并等功能。用户只需通过简单的界面操作，即可轻松完成数据的匹配与合并任务，大大提高了数据处理效率和准确性。

具体来说，该工具首先通过初始化用户表单，填充下拉框选项，方便用户选择需要操作的工作表和列。然后，根据用户的选择，工具会自动读取指定工作表中的数据，进行匹配与合并操作。在匹配过程中，工具利用字典对象来存储和查找数据，实现了高效的匹配算法。最后，工具将匹配结果合并到指定的工作表中，并弹出提示框通知用户操作完成。

完整代码如下：

Private Sub UserForm_Initialize() Dim ws As Worksheet ' 填充表的下拉框 For Each ws In Worksheets ComboBox1.AddItem ws.Name ComboBox3.AddItem ws.Name Next ws End SubPrivate Sub ComboBox1_Change() FillColumnCombo ComboBox1, ComboBox2End SubPrivate Sub ComboBox3_Change() FillColumnCombo ComboBox3, ComboBox4End SubPrivate Sub FillColumnCombo(ByRef cbSheet As ComboBox, ByRef cbColumn As ComboBox) Dim ws As Worksheet Dim col As Range cbColumn.Clear Set ws = Worksheets(cbSheet.Value) For Each col In ws.UsedRange.rows(1).Columns cbColumn.AddItem Replace(col.Address(False, False), "1", "") Next colEnd SubPrivate Sub CommandButton1_Click() Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRow1 As Long, lastRow2 As Long Dim i As Long Dim dict As Object Dim seqDict As Object Dim valToFind As Variant Dim colAssembly As Long Dim colDebug As Long ' 设置工作表和列 Set ws1 = Sheets(ComboBox1.Value) Set ws2 = Sheets(ComboBox3.Value) colAssembly = Columns(ComboBox2.Value).Column colDebug = Columns(ComboBox4.Value).Column ' 获取装配和调试的最后一行 lastRow1 = ws1.Cells(ws1.rows.Count, colAssembly).End(xlUp).Row lastRow2 = ws2.Cells(ws2.rows.Count, colDebug).End(xlUp).Row ' 创建字典对象 Set dict = CreateObject("Scripting.Dictionary") Set seqDict = CreateObject("Scripting.Dictionary") ' 用于跟踪序列号 ' 将调试表选择列的值和对应的第一列的值存入字典 Dim key As Variant For i = 2 To lastRow2 key = ws2.Cells(i, colDebug).Value ' 初始化序列号 If Not seqDict.exists(key) Then seqDict(key) = 1 End If ' 合并并添加序列号 If dict.exists(key) Then dict(key) = dict(key) & vbCrLf & CStr(seqDict(key)) & ". " & CStr(ws2.Cells(i, val(TextBox2.Value)).Value) Else dict(key) = CStr(seqDict(key)) & ". " & ws2.Cells(i, val(TextBox2.Value)).Value End If ' 递增序列号 seqDict(key) = seqDict(key) + 1 Next i ' 循环遍历装配的选择列 For i = 2 To lastRow1 valToFind = ws1.Cells(i, colAssembly).Value ' 获取装配选择列的值 ' 使用字典快速查找匹配的值 If dict.exists(valToFind) Then ' 如果匹配，将调试对应的第一列的值合并后赋值给装配第11列的当前行 ws1.Cells(i, val(TextBox1.Value)).Value = dict(valToFind) End If Next i ' 释放字典对象 Set dict = Nothing Set seqDict = Nothing MsgBox "匹配并合并完成！", vbInformationEnd Sub