Wie kann ich diese 2 Ereignisse von worksheet_change kombinieren?

Question

Ich versuche, mehrere Arbeitsblattänderungsereignisse auszuführen, aber ich weiß nicht, wie die zwei Makros kombiniert werden. Kann mir bitte jemand zeigen, wie man sie kombiniert? Macro 1

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
If Target.Count > 1 Then GoTo exitHandler 

On Error Resume Next 
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
On Error GoTo exitHandler 

If rngDV Is Nothing Then GoTo exitHandler 

If Intersect(Target, rngDV) Is Nothing Then 
Else 
    Application.EnableEvents = False 
    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 
    If Target.Column = 9 Then 
    If oldVal = "" Then 

     Else 
     If newVal = "" Then 

     Else 
     Target.Value = oldVal _ 
     & ", " & newVal 

     End If 
    End If 
    End If 
End If 

exitHandler: 
    Application.EnableEvents = True 
End Sub 

Macro 2

Private Sub Worksheet_Change(ByVal Target As Range) 
On Error Resume Next 
Dim ws As Worksheet 
Dim str As String 
Dim i As Integer 
Dim rngDV As Range 
Dim rng As Range 

If Target.Count > 1 Then Exit Sub 
Set ws = Worksheets("Lists") 

If Target.Row > 1 Then 
    On Error Resume Next 
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
    On Error GoTo 0 
    If rngDV Is Nothing Then Exit Sub 

    If Intersect(Target, rngDV) Is Nothing Then Exit Sub 

    str = Target.Validation.Formula1 
    str = Right(str, Len(str) - 1) 
    On Error Resume Next 
    Set rng = ws.Range(str) 
    On Error GoTo 0 
    If rng Is Nothing Then Exit Sub 

    If Application.WorksheetFunction _ 
    .CountIf(rng, Target.Value) Then 
    Exit Sub 
    Else 
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 
    ws.Cells(i, rng.Column).Value = Target.Value 
    rng.Sort Key1:=ws.Cells(1, rng.Column), _ 
     Order1:=xlAscending, Header:=xlNo, _ 
     OrderCustom:=1, MatchCase:=False, _ 
     Orientation:=xlTopToBottom 
    End If 

End If 

End Sub 

Answer 1

Beide Codes sind unter einem Arbeitsblatt ändern Ereignis verschmolzen.

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rngDV As Range, oldVal As String, newVal As String 

If Target.Columns.Count > 1 Then GoTo exitHandler 
If Target.Cells.Count > 1 Then GoTo exitHandler 

On Error Resume Next 
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
On Error GoTo exitHandler 

If rngDV Is Nothing Then GoTo exitHandler 

If Not Intersect(Target, rngDV) Is Nothing Then 
    Application.EnableEvents = False 

    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 

    If Target.Column = 9 Then 
     If oldVal <> "" Then 
      If newVal <> "" Then Target.Value = oldVal & ", " & newVal 
     End If 
    End If 
End If 

exitHandler: 
    Application.EnableEvents = True 

'Second Code Added Here... 
Dim ws As Worksheet, str As String, i As Integer, rngDV As Range, rng As Range 

Set ws = Worksheets("Lists") 

If Target.Row > 1 Then 
    On Error Resume Next 
     Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
    On Error GoTo 0 

    If rngDV Is Nothing Then Exit Sub 
    If Intersect(Target, rngDV) Is Nothing Then Exit Sub 

    str = Target.Validation.Formula1 
    str = Right(str, Len(str) - 1) 

    On Error Resume Next 
     Set rng = ws.Range(str) 
    On Error GoTo 0 

    If rng Is Nothing Then Exit Sub 

    If Application.WorksheetFunction.CountIf(rng, Target.Value) Then 
     Exit Sub 
    Else 
     i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 
     ws.Cells(i, rng.Column).Value = Target.Value 
     rng.Sort Key1:=ws.Cells(1, rng.Column), _ 
     Order1:=xlAscending, Header:=xlNo, _ 
     OrderCustom:=1, MatchCase:=False, _ 
     Orientation:=xlTopToBottom 
    End If 
End If 

End Sub 

Answer 2

Vielen Dank für alle. Ich ging mit:

Private Sub Worksheet_Change(ByVal Target As Range) 

' Multiple Select 

Dim rngDV As Range 
Dim oldVal As String 
Dim newVal As String 
If Target.Count > 1 Then GoTo exitHandler 

On Error Resume Next 
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
On Error GoTo exitHandler 

If rngDV Is Nothing Then GoTo exitHandler 

If Intersect(Target, rngDV) Is Nothing Then 
    'do nothing 
Else 
    Application.EnableEvents = False 
    newVal = Target.Value 
    Application.Undo 
    oldVal = Target.Value 
    Target.Value = newVal 
    If Target.Column = 2 _ 
     And Target.Row = 3 _ 
     Or Target.Row >= 9 Then 
    If oldVal = "" Then 
     'do nothing 
     Else 
     If newVal = "" Then 
     'do nothing 
     Else 
     Target.Value = oldVal _ 
     & ", " & newVal 

     End If 
    End If 
    End If 
End If 

exitHandler: 
    Application.EnableEvents = True 


    ' Add to List data 
On Error Resume Next 
Dim ws As Worksheet 
Dim str As String 
Dim i As Integer 
Dim rng As Range 

If Target.Count > 1 Then Exit Sub 
Set ws = Worksheets("dynamicLists") 

If Target.Row > 1 Then 
    On Error Resume Next 
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) 
    On Error GoTo 0 
    If rngDV Is Nothing Then Exit Sub 

    If Intersect(Target, rngDV) Is Nothing Then Exit Sub 

    str = Target.Validation.Formula1 
    str = Right(str, Len(str) - 1) 
    On Error Resume Next 
    Set rng = ws.Range(str) 
    On Error GoTo 0 
    If rng Is Nothing Then Exit Sub 

    If Application.WorksheetFunction _ 
    .CountIf(rng, Target.Value) Then 
    Exit Sub 
    Else 
    i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1 
    ws.Cells(i, rng.Column).Value = Target.Value 
    rng.Sort Key1:=ws.Cells(1, rng.Column), _ 
     Order1:=xlAscending, Header:=xlNo, _ 
     OrderCustom:=1, MatchCase:=False, _ 
     Orientation:=xlTopToBottom 
    End If 

End If 


End Sub 

Answer 3

Natürlich können Sie es so machen.

Sub Macro1() 
' your code here 

Call Macro2 
End Sub 

Sub Macro2() 
' your code here 

End Sub