如何合并两个含ByVal Target As Range的Excel VBA宏？求助

看起来你遇到的问题主要是两个事件过程的触发逻辑互相干扰，再加上原代码里的错误处理和事件触发没有妥善处理导致的。其实这两个事件（Worksheet_SelectionChange 和 Worksheet_Change）不需要合并成一个过程，只需要把它们放在同一个工作表模块中，调整代码避免互相干扰即可。

以下是修正后的完整代码，直接替换你工作表模块里的现有代码就能正常运行：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 禁用事件，避免插入行时触发Worksheet_Change事件造成循环干扰
    Application.EnableEvents = False
    
    On Error GoTo ErrorHandler ' 替换On Error Resume Next，以便捕获并处理错误
    
    ' 处理E15:E45区域的行插入逻辑
    If Not Intersect(Target, Me.Range("E15:E45")) Is Nothing Then
        With Target.EntireRow
            .Copy
            .Offset(1, 0).Insert Shift:=xlShiftDown
            Application.CutCopyMode = False ' 清除复制状态，避免剪贴板残留
        End With
    End If
    
    ' 自动调整F:N列宽
    Me.Range("F:N").EntireColumn.AutoFit
    ' 设置I列为文本格式
    Me.Columns(9).NumberFormat = "@"

ErrorHandler:
    ' 无论是否出错，必须恢复事件触发，否则后续事件会失效
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "SelectionChange事件出错: " & Err.Description, vbExclamation
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim w2 As Worksheet
    
    ' 禁用事件，避免写入单元格时再次触发Change事件
    Application.EnableEvents = False
    
    On Error GoTo ErrorHandler
    
    Set w2 = ThisWorkbook.Sheets("Lookups")
    
    ' 处理H列的输入逻辑
    If Not Intersect(Me.Range("H:H"), Target) Is Nothing Then
        For Each cell In Intersect(Me.Range("H:H"), Target)
            cell.Offset(0, 1).Interior.ColorIndex = xlNone
            If cell.Value <> "" Then
                Call macro2(cell, w2) ' 传递工作表对象，避免重复创建
            Else
                ' 空值时清空对应列内容并标记颜色
                cell.Offset(0, 1).Interior.ColorIndex = 3
                cell.Offset(0, 1).Value = ""
                cell.Offset(0, -1).Value = ""
            End If
        Next cell
    End If

ErrorHandler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "Change事件出错: " & Err.Description, vbExclamation
    End If
End Sub

Sub macro2(T As Range, w2 As Worksheet)
    Dim F As Range
    ' 明确查找参数，避免默认值导致的意外结果
    Set F = w2.Range("H:H").Find(T.Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not F Is Nothing Then
        T.Offset(0, 1).Value = F.Offset(0, 1).Value
        T.Offset(0, -1).Value = F.Offset(0, 2).Value
    Else
        ' 未找到匹配项时的处理
        T.Offset(0, 1).Interior.ColorIndex = 3
        T.Offset(0, 1).Value = ""
        T.Offset(0, -1).Value = ""
    End If
End Sub

关键修改点说明： #

• 事件触发控制：在两个事件过程开头都加入Application.EnableEvents = False，操作完成后恢复为True。这是因为你在SelectionChange中插入行的操作会触发Worksheet_Change事件，而Change中写入单元格的操作也会再次触发自身，禁用事件可以避免这种循环干扰。
• 错误处理优化：替换了原代码中的On Error Resume Next，改用定向错误捕获，既能发现代码问题，又能确保事件触发始终恢复，不会导致后续事件失效。
• 使用Me指代当前工作表：避免ActiveCell、硬编码工作表名称这类不可靠写法，Me在工作表模块中直接指代当前工作表，逻辑更稳定。
• 优化子过程参数传递：把工作表对象w2作为参数传给macro2，避免重复创建对象，提升代码效率。
• 补充空值处理逻辑：当H列单元格为空时，同步清空对应G列和I列内容，让逻辑更完整。

注意事项： #

1. 确保所有代码都放在对应工作表的模块中（比如"Load"工作表的代码模块），不要放在标准模块里。
2. 测试时可以先注释掉错误提示的MsgBox，确保逻辑正常后再开启。

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