[英]Combine two Private Sub Worksheet_Change(ByVal Target As Range)
[英]Combine two "Private Sub Worksheet_Change(ByVal Target As Range)"
我的工作表中有以下两个代码,我希望它们都运行 - 目前我收到一个宏错误。 你能帮我把它们组合起来,让它们都能运行吗??
一个在输入数据时在相邻单元格中输入日期,另一个允许从下拉列表中进行多项选择。 两者都单独工作。
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
非常感谢
每张纸只能有一个Worksheet_Change
事件。 一个简单的解决方法是将您的两个Events
转换为Sub Procedures
,然后创建一个主Event
,该Event
简单地调用您的其他两个子程序。
设置看起来像这样
Private Sub Worksheet_Change(ByVal Target As Range)
AddDate Target
Dropdown Target
End Sub
Sub AddDate (Target as Range)
'Your first code goes here
End Sub
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.