Excel VBA新手求助：根据经办人匹配设备并添加序列号

需求明确 #

核心逻辑：当Personnel工作表（Sheet1）A列经办人信息修改时，匹配Equipment_List工作表（Sheet2）中对应经办人的设备名称，自动将对应的序列号填充到Personnel表的指定列。

实现步骤与示例代码 #

1. 代码逻辑说明 #

采用字典（Dictionary）存储设备清单的匹配关系，避免重复循环查找提升效率；通过工作表变更事件（Worksheet_Change）自动触发匹配操作。

2. 完整代码 #

按Alt+F11打开VBA编辑器，双击左侧工程窗口中的Personnel工作表，粘贴以下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅响应A列单元格的修改
    If Intersect(Target, Me.Columns("A")) Is Nothing Then Exit Sub
    
    Dim wsEquip As Worksheet
    Dim lastRowEquip As Long
    Dim dict As Object
    Dim i As Long
    Dim matchKey As String
    Dim targetRow As Long
    
    ' 指定设备清单工作表
    Set wsEquip = ThisWorkbook.Worksheets("Equipment_List")
    ' 获取设备清单的最后一行（跳过表头）
    lastRowEquip = wsEquip.Cells(wsEquip.Rows.Count, "A").End(xlUp).Row
    
    ' 创建字典存储【经办人+设备名】与序列号的映射
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历设备清单，填充字典
    For i = 2 To lastRowEquip
        ' 用|拼接经办人+设备名作为唯一键，避免重复
        matchKey = wsEquip.Cells(i, "A").Value & "|" & wsEquip.Cells(i, "B").Value
        dict(matchKey) = wsEquip.Cells(i, "C").Value
    Next i
    
    ' 处理所有修改的单元格所在行
    For Each cell In Target
        targetRow = cell.Row
        ' 跳过表头行
        If targetRow = 1 Then Continue For
        
        ' 生成当前行的匹配键
        matchKey = cell.Value & "|" & Me.Cells(targetRow, "B").Value
        
        ' 匹配并填充序列号
        If dict.Exists(matchKey) Then
            Me.Cells(targetRow, "C").Value = dict(matchKey)
        Else
            Me.Cells(targetRow, "C").Value = "无匹配记录"
        End If
    Next cell
    
    ' 释放资源
    Set dict = Nothing
    Set wsEquip = Nothing
End Sub

3. 自定义调整说明 #

根据你的实际表结构修改以下参数：

• 工作表名称：如果Equipment_List不是Sheet2的实际名称，替换ThisWorkbook.Worksheets("Equipment_List")中的表名
• 列对应关系：
  • 若Equipment_List中经办人在D列、设备名在E列、序列号在F列，修改代码中wsEquip.Cells(i, "A")为wsEquip.Cells(i, "D")，以此类推
  • 若Personnel表中设备名在C列、序列号要填充到D列，修改Me.Cells(targetRow, "B")为Me.Cells(targetRow, "C")，Me.Cells(targetRow, "C")为Me.Cells(targetRow, "D")

新手调试提示 #

• 按F8可逐行执行代码，查看每一步变量的值，排查逻辑问题
• 测试前备份工作簿，避免数据意外覆盖
• 代码中CreateObject("Scripting.Dictionary")已兼容所有Excel版本，无需额外引用组件

内容的提问来源于stack exchange，提问作者Won6ton