[英]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.