これらの2つのworksheet_changeイベントをどのように組み合わせることができますか？

Question

複数のワークシート変更イベントを実行しようとしていますが、2つのマクロを組み合わせる方法がわかりません。誰も私にそれらを組み合わせる方法を教えてもらえますか？ マクロ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 

マクロ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

どちらのコードが1つのワークシート変更イベントの下にマージされます。

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

ありがとうございます。私は一緒に行った：

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

もちろんこのようにすることができます。

Sub Macro1() 
' your code here 

Call Macro2 
End Sub 

Sub Macro2() 
' your code here 

End Sub