需求：通过Excel VBA实现输入型号自动匹配输出IMEI

核心代码 #

Sub GetIMEIFromModel()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim i As Long, j As Long
    Dim model As String
    Dim imeiList As String
    
    ' 指定数据源表和目标表
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取数据源和目标表的最后行号
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历目标表中的所有型号
    For i = 2 To lastRowTarget ' 假设第一行是表头，从第二行开始
        model = wsTarget.Cells(i, "A").Value
        imeiList = ""
        
        If model <> "" Then
            ' 在数据源中匹配型号，收集对应IMEI
            For j = 2 To lastRowSource ' 假设数据源第一行是表头
                If wsSource.Cells(j, "A").Value = model Then
                    If imeiList = "" Then
                        imeiList = wsSource.Cells(j, "B").Value
                    Else
                        imeiList = imeiList & ", " & wsSource.Cells(j, "B").Value ' 多个IMEI用逗号分隔
                    End If
                End If
            Next j
            
            ' 将结果写入目标表相邻单元格
            wsTarget.Cells(i, "B").Value = imeiList
        Else
            wsTarget.Cells(i, "B").Value = "" ' 空型号对应空值
        End If
    Next i
    
    MsgBox "IMEI提取完成！", vbInformation
End Sub

使用说明 #

• 列对应规则：代码默认Sheet1的型号在A列、IMEI在B列；Sheet2的型号输入在A列，结果输出到B列。如果你的实际列位置不同，修改代码中"A"、"B"为对应列标识即可。
• 表头处理：假设两张表的第一行都是表头，代码从第二行开始遍历数据。如果无表头，把循环起始的2改成1。
• 运行方式：
  1. 按Alt + F11打开VBA编辑器
  2. 右键点击当前工作簿 → 插入 → 模块
  3. 粘贴上述代码，按F5运行，或者返回Excel后通过「开发工具」→「宏」选择GetIMEIFromModel执行

扩展优化（可选） #

如果希望在Sheet2输入型号后自动触发提取，可以添加工作表事件代码：

' 此代码需粘贴到Sheet2的代码窗口中（不是模块）
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim modelRow As Long
    Dim model As String
    Dim imeiList As String
    Dim j As Long
    Dim lastRowSource As Long
    Dim wsSource As Worksheet
    
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 仅当修改A列单元格时触发
    If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
        modelRow = Target.Row
        model = Me.Cells(modelRow, "A").Value
        imeiList = ""
        
        If model <> "" Then
            For j = 2 To lastRowSource
                If wsSource.Cells(j, "A").Value = model Then
                    If imeiList = "" Then
                        imeiList = wsSource.Cells(j, "B").Value
                    Else
                        imeiList = imeiList & ", " & wsSource.Cells(j, "B").Value
                    End If
                End If
            Next j
            Me.Cells(modelRow, "B").Value = imeiList
        Else
            Me.Cells(modelRow, "B").Value = ""
        End If
    End If
End Sub

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