请求编写VBA代码：自动填充重复客户的相邻手机号

下面的VBA代码会监听G、I、K、M列的单元格输入，当输入的客户姓名在之前的记录中出现过时，自动将对应手机号填充到相邻的H、J、L、N列（姓名列的右侧列）。

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 定义需要监控的姓名列：G, I, K, M
    Dim nameCols As Variant
    nameCols = Array("G", "I", "K", "M")
    
    Dim targetCol As String
    targetCol = Split(Target.Address, "$")(1)
    
    ' 检查当前修改的单元格是否在目标姓名列中，且仅单个单元格修改
    If UBound(Filter(nameCols, targetCol)) = -1 Or Target.Cells.Count > 1 Then Exit Sub
    
    Dim nameValue As String
    nameValue = Trim(Target.Value)
    If nameValue = "" Then Exit Sub ' 空值不处理
    
    Dim phoneCol As String
    ' 获取对应手机号列（姓名列右侧一列）
    phoneCol = Chr(Asc(targetCol) + 1)
    
    ' 在所有姓名列中查找已存在的同名记录
    Dim searchRange As Range
    Set searchRange = Union(Me.Range("G:G"), Me.Range("I:I"), Me.Range("K:K"), Me.Range("M:M"))
    
    Dim foundCell As Range
    Set foundCell = searchRange.Find(What:=nameValue, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    
    ' 如果找到匹配项，且不是当前单元格本身，填充手机号
    If Not foundCell Is Nothing And foundCell.Address <> Target.Address Then
        ' 获取找到的姓名对应的手机号
        Dim matchedPhone As String
        matchedPhone = Me.Cells(foundCell.Row, Asc(foundCell.Column) + 1).Value
        
        ' 填充当前姓名对应的手机号列，避免覆盖已手动输入的内容
        If Me.Cells(Target.Row, phoneCol).Value = "" Then
            Application.EnableEvents = False ' 禁用事件避免循环触发
            Me.Cells(Target.Row, phoneCol).Value = matchedPhone
            Application.EnableEvents = True
        End If
    End If
End Sub

代码说明 #

• 监听范围：仅对G、I、K、M列的单个单元格输入做出响应，批量修改不触发。
• 空值跳过：如果输入的姓名为空，直接退出，避免无效处理。
• 查找逻辑：在所有目标姓名列中精确匹配已存在的客户姓名，忽略大小写。
• 避免覆盖：仅当当前手机号单元格为空时才自动填充，不会覆盖已手动输入的内容。
• 事件控制：填充手机号时临时禁用工作表事件，防止重复触发Change事件。

使用方法 #

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器。
2. 在左侧工程窗口中找到对应的工作表（比如Sheet1），双击打开。
3. 将上述代码粘贴到代码窗口中，保存文件为**启用宏的工作簿（.xlsm）**格式。

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