如何在一张纸中使用多个私有子 Worksheet_Change(ByVal Target As Range)

Question

嗨团队，请任何人都可以帮助我，当我在我的工作表中使用此代码时

Option Explicit

Private Sub ComboBox1_GotFocus()
ComboBox1.ListFillRange = "DropDownList"
Me.ComboBox1.DropDown
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
Sheet12.[F5] = ActiveCell.Row
End If
End Sub

**它完美地工作，我没有收到任何错误或消息，

当我在我的工作表中单独使用此代码时**

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCell As Range, m, v
    Dim rngCell1 As Range, m1, v1
    
Check1:

    If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
    
    For Each rngCell In Range("B19:B38")
        v = rngCell.Value
        If Len(v) > 0 Then

            'See if the value is in your lookup table
            m = Application.VLookup(v, _
                 ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m) Then rngCell.Value = m
End If
    Next
Exit Sub

Check2:

    If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub

    For Each rngCell1 In Range("A6,D6")
        v1 = rngCell1.Value
        If Len(v1) > 0 Then

            'See if the value is in your lookup table
            m1 = Application.VLookup(v1, _
                 ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m1) Then rngCell1.Value = m1

        End If
        Next


      On Error GoTo Hell
If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
    Range("B14:B23").Value = ""
End If
Hell:

End Sub

**它也完美地工作。 我从来没有遇到任何问题或错误。 但是当我在我的工作表中使用这两个代码时，它给了我一个错误，因为两个

Private Sub Worksheet_Change(ByVal Target As Range)

如何将这些代码合二为一。 请帮我。 **

Answer 1

这是因为您不能两次使用相同的子名称。 但是，您可以将其中一个的内容复制到另一个 Sub 的内容之前。 然后他们被互相处决。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error Resume Next
  If Target.Column = 2 And (Target.Row > 18 And Target.Row < 39) Then
    Sheet12.[F5] = ActiveCell.Row
  End If
  On Error Goto 0

    Dim rngCell As Range, m, v
    Dim rngCell1 As Range, m1, v1
    
Check1:

    If Application.Intersect(Target, Range("B19:B38")) Is Nothing Then GoTo Check2:
    
    For Each rngCell In Range("B19:B38")
        v = rngCell.Value
        If Len(v) > 0 Then

            'See if the value is in your lookup table
            m = Application.VLookup(v, _
                 ThisWorkbook.Sheets("ItemName").Range("D2:E1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m) Then rngCell.Value = m
  End If
    Next
  Exit Sub

Check2:

    If Application.Intersect(Target, Range("A6,D6")) Is Nothing Then Exit Sub

    For Each rngCell1 In Range("A6,D6")
        v1 = rngCell1.Value
        If Len(v1) > 0 Then

            'See if the value is in your lookup table
            m1 = Application.VLookup(v1, _
                 ThisWorkbook.Sheets("PARTY LEDGER").Range("B2:C1001"), 2, False)

            'If found a match then replace wiht the vlookup result
            If Not IsError(m1) Then rngCell1.Value = m1

        End If
        Next


      On Error GoTo Hell
  If Target.Address(False, False) = "A6" And Target.Validation.Type = 3 Then
    Range("B14:B23").Value = ""
  End If
Hell:


End Sub