Объединить два «Private Sub Worksheet_Change (ByVal Target As Range)»

Question

У меня есть следующие два кода на моем листе, и я хочу, чтобы они оба работали - в настоящее время я получаю макрос ошибки.Не могли бы вы помочь мне объединить их так, чтобы они оба выполнялись ??

Один вводит дату в соседнюю ячейку при вводе данных, другой допускает множественный выбор из раскрывающегося списка.Оба работают индивидуально.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("O:O"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

А другой код:

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
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 10 _
     Or Target.Column = 12 Then
    If oldVal = "" Then
       'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
    & ", " & newVal
'      NOTE: you can use a line break,
'      instead of a comma
'      Target.Value = oldVal _
'        & Chr(10) & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Большое спасибо

Answer 1

На листе может быть только одно Worksheet_Change событие.Простой обходной путь - превратить ваши два Events в Sub Procedures, а затем создать мастер Event, который просто вызывает оба ваших других сабвуфера.

Настройка будет выглядеть примерно так

---

Событие

Private Sub Worksheet_Change(ByVal Target As Range)
    AddDate Target
    Dropdown Target
End Sub

Подпроцедура 1

Sub AddDate (Target as Range)
    'Your first code goes here
End Sub

Подпрограмма 2

Sub Dropdown (Target as Range)
    'Your second code goes here
End Sub

---

Я бы лично установил ваши проверки в Event и соответственно назвал бы ваши процедуры.Тогда ваши подпрограммы могут строго сосредоточиться на утверждениях действия, скорее всего, не нужно выполнять какую-либо проверку.

Это может выглядеть примерно так (обратите внимание, что все переменные диапазона уже инициированы и больше не нуждаются в объявлении)

Private Sub Worksheet_Change(ByVal Target As Range)

'DateAdd Validation
Dim WorkRng As Range
Set WorkRng = Intersect(Application.ActiveSheet.Range("O:O"), Target)

If Not WorkRng Is Nothing Then
    DateAdd Target, WorkRng
End If

'Dropdown Validation
Dim rngDV As Range
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)

If Target.Count = 1 Then
    If Not rngDV Is Nothing Then '<-- I believe this is redundant
        If Not Intersect(Target, rngDV) Is Nothing Then
            Dropdown Target, rngDV
        End If
    End If
End If

End Sub

Sub DateAdd(Target As Range, WorkRng As Range)

End Sub

Sub Dropdown(Target As Range, rngDV As Range)

End Sub