合並相同的主題EXCEL VBA代碼

Question

我想在同一張表中同時啟用這兩個worksheet_change事件過程。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, V As Variant, N As Long
Set r = Intersect(Range("H6"), Target)
If r Is Nothing Then Exit Sub
  V = r(1).Value
Application.EnableEvents = False
    N = Cells(Rows.Count, "K").End(xlUp).Row
    If IsEmpty(Range("K11").Value) = True Then
    Cells(N + 10, 11).Value = V
    Else
    Cells(N + 1, 11).Value = V
 End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, V As Variant, N As Long
Set r = Intersect(Range("J6"), Target)
If r Is Nothing Then Exit Sub
  V = r(1).Value
Application.EnableEvents = False
    N = Cells(Rows.Count, "P").End(xlUp).Row
    If IsEmpty(Range("K16").Value) = True Then
    Cells(N + 10, 16).Value = V
    Else
    Cells(N + 1, 16).Value = V
 End If
Application.EnableEvents = True
End Sub

Answer 1

將它們合並為一個事件。 您可以將我的msgbox代碼替換為觸發特定單元格時想要發生的事情。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r1 As Range
    Dim r2 As Range, V As Variant, N As Long

    Set r1 = Range("H6")
    Set r2 = Range("J6")

    If Application.Intersect(Target, Union(r1, r2)) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    If Target.Address(0, 0) = "H6" Then

        MsgBox "H6 triggered" 'your H6 code

    ElseIf Target.Address(0, 0) = "J6" Then

        MsgBox "J6 triggered" 'your J6 code

    Else
       MsgBox "Unexpected error"
    End If

    Application.EnableEvents = True

End Sub

使用您的代碼：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r1 As Range
    Dim r2 As Range, V As Variant, N As Long

    Set r1 = Range("H6")
    Set r2 = Range("J6")

    If Application.Intersect(Target, Union(r1, r2)) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    If Target.Address(0, 0) = "H6" Then

        V = r1(1).Value
        N = Cells(Rows.Count, "K").End(xlUp).Row

        If IsEmpty(Range("K11").Value) = True Then
            Cells(N + 10, 11).Value = V
        Else
            Cells(N + 1, 11).Value = V
        End If

    ElseIf Target.Address(0, 0) = "J6" Then

        V = r2(1).Value

        N = Cells(Rows.Count, "P").End(xlUp).Row

        If IsEmpty(Range("K16").Value) = True Then
            Cells(N + 10, 16).Value = V
        Else
            Cells(N + 1, 16).Value = V
        End If

    Else
        MsgBox "Unexpected error"
    End If

    Application.EnableEvents = True

End Sub