我可以單獨使用下面的兩個 subs 并且它們作業正常，但我無法弄清楚如何在同一張紙上一起使用它們。當我這樣做時，無論我如何重新排列，我都會不斷出錯。
第一個子：
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="incoming"
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("b:b"), 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 = "mm-dd-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
ActiveSheet.Protect Password:="incoming"
End If
End Sub
第二個子：
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="incoming"
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("g:g"), Target)
xOffsetColumn = 2
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 = "mm-dd-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
ActiveSheet.Protect Password:="incoming"
End If
End Sub
uj5u.com熱心網友回復：
所有子項（在給定范圍內）必須具有唯一名稱。因此，對于任何給定的作業表事件，您只能有一個事件處理程式（即在給定的作業表模塊中只有一個名為 Worksheet_Change 的子）。我不太確定您的意圖，但是（作為最佳猜測）以下代碼“重新安排”似乎是您想要做的。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xOffsetColumn%, Rng As Range, WorkRng As Range
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="incoming"
Set WorkRng = Intersect(ActiveSheet.Range("b:b"), Target)
If Not WorkRng Is Nothing Then
xOffsetColumn = -1
For Each Rng In WorkRng.Cells
If Rng <> "" Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
End If
Set WorkRng = Intersect(ActiveSheet.Range("g:g"), Target)
If Not WorkRng Is Nothing Then
xOffsetColumn = 2
For Each Rng In WorkRng.Cells
If Rng <> "" Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
End If
ActiveSheet.Protect Password:="incoming"
Application.EnableEvents = True
End Sub
您當然可以重構上述內容以簡化和/或使您的代碼更優雅。以上應該解決你的核心問題。
uj5u.com熱心網友回復：
在您的模塊上使用Option Explicit。
一張作業表上只能有一個Worksheet_Change事件。
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="incoming"
Dim WorkRng As Range
Dim xOffsetColumn As Integer
If Not Intersect(Application.ActiveSheet.Range("b:b"), Target) Is Nothing Then
Set WorkRng = Intersect(Application.ActiveSheet.Range("b:b"), Target)
xOffsetColumn = -1
Call DoYourStuff(WorkRng, xOffsetColumn)
End If
If Not Intersect(Application.ActiveSheet.Range("g:g"), Target) Is Nothing Then
Set WorkRng = Intersect(Application.ActiveSheet.Range("g:g"), Target)
xOffsetColumn = 2
Call DoYourStuff(WorkRng, xOffsetColumn)
End If
ActiveSheet.Protect Password:="incoming"
End Sub
Private Sub DoYourStuff(rg As Range, Col As Long)
Dim Rng As Range
Application.EnableEvents = False
For Each Rng In rg
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, Col).Value = Now
Rng.Offset(0, Col).NumberFormat = "mm-dd-yyyy"
Else
Rng.Offset(0, Col).ClearContents
End If
Next
Application.EnableEvents = True
End Sub
uj5u.com熱心網友回復：
作業表更改（多個標準）
片材模塊例如 Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const FirstRow As Long = 2
Const sColsList As String = "B,G"
Dim sCols() As String: sCols = Split(sColsList, ",")
Dim irg As Range
Dim srg As Range
Dim n As Long
Dim rOffset As Long
For n = 0 To UBound(sCols)
rOffset = FirstRow - 1
With Me.Columns(sCols(n))
Set srg = .Resize(.Rows.Count - rOffset).Offset(rOffset)
End With
Set irg = Intersect(srg, Target)
If Not irg Is Nothing Then
ProcessColumnRange irg, n
End If
Next n
End Sub
標準模塊例如 Module1
Option Explicit
Sub ProcessColumnRange( _
ByVal SourceRange As Range, _
ByVal ColumnIndex As Long)
' Needs the 'RefCombinedRange' function.
Const tsNumberFormat As String = "mm-dd-yyyy"
Const dColsList As String = "A,I"
Const Pwd As String = "incoming"
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo ClearError
Dim ws As Worksheet: Set ws = SourceRange.Worksheet
ws.Unprotect Pwd
Dim dCols() As String: dCols = Split(dColsList, ",")
Dim dCol As String: dCol = dCols(ColumnIndex)
Dim sCell As Range ' Source Cell
Dim dCell As Range ' Destionation Cell
Dim dcrg As Range ' Destination Clear Range
Dim dtsrg As Range ' Destination Time Stamp Range
For Each sCell In SourceRange.Cells
Set dCell = sCell.EntireRow.Columns(dCol)
If IsEmpty(sCell) Then
If Not IsEmpty(dCell) Then
Set dcrg = RefCombinedRange(dcrg, dCell)
End If
Else
Set dtsrg = RefCombinedRange(dtsrg, dCell)
End If
Next sCell
If Not dcrg Is Nothing Then
dcrg.ClearContents
End If
If Not dtsrg Is Nothing Then
Dim TimeStamp As Date: TimeStamp = Now
dtsrg.Value = TimeStamp
dtsrg.NumberFormat = tsNumberFormat
End If
ws.Protect Pwd
SafeExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
ByVal CombinedRange As Range, _
ByVal AddRange As Range) _
As Range
If CombinedRange Is Nothing Then
Set RefCombinedRange = AddRange
Else
Set RefCombinedRange = Union(CombinedRange, AddRange)
End If
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/346669.html