合并两个“ Private Sub Worksheet_Change（ByVal目标作为范围）”

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