我使用以下代碼如下：
Code(1)@ Worksheet_SelectionChange通過在作業表“北”列 M上使用日期選擇器（日歷）插入日期
。
Code(2) @ Worksheet_Change作業表北記錄任何單元格的變化并放入作業表（“日志”）。
Code(3)在單獨的模塊“日歷”中啟動日歷
這些代碼在一種情況下有效，但
不是由事件觸發的目標單元格不會Worksheet_Change
產生問題，使用日歷輸入任何值，not click outside Column M然后再次洗掉這些值，然后切換到“日志”表，您會注意到根本沒有洗掉值的條目。
一如既往：任何幫助將不勝感激。
（在第一條評論中找到的真實檔案的鏈接）
Option Explicit
Option Compare Text
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("M3:M100")) Is Nothing Then
Call Basic_Calendar
Else
boolDate = False 'make it false to trigger the previous behavior in Worksheet_Change event
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range) 'Log Changes of Current Sheet and put in Sheet("Log")
Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue 'the array to keep Target values (before UnDo)
Dim SH As Worksheet: Set SH = Sheets("Log")
Dim UN As String: UN = Application.UserName
If Not Intersect(Target, Range("AK:XFD")) Is Nothing Then Exit Sub 'not doing anything if a cell in AK:XFD is changed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target.Cells.Count > 1 Then
TgValue = ExtractData(Target)
Else
TgValue = Array(Array(Target.value, Target.Address(0, 0))) 'Put the target range in an array (or as a string for a single cell)
boolOne = True
End If
Application.EnableEvents = False 'Avoide trigger the change event after UnDo
If boolDate Then '____________________________________________________________
Dim prevTarget
prevTarget = Target.value 'memorize the target value
Target.value = PrevVal 'change the target value to the one before changing
RangeValues = ExtractData(Target) 'extract data exactly as before
Target.value = prevTarget 'set the last date
Else '____________________________________________________________
Application.Undo
RangeValues = ExtractData(Target) 'Define RangeValue
PutDataBack TgValue, ActiveSheet 'Put back the changed data
End If
If boolOne Then Target.Offset(1).Select
Application.EnableEvents = True
Dim columnHeader As String, rowHeader As String
For r = 0 To UBound(RangeValues)
If RangeValues(r)(0) <> TgValue(r)(0) Then
columnHeader = Cells(1, Range(RangeValues(r)(1)).Column).value
rowHeader = Range("B" & Range(RangeValues(r)(1)).Row).value
Sheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 6).value = _
Array(UN, Now, rowHeader, columnHeader, TgValue(r)(0), RangeValues(r)(0))
End If
Next r
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub PutDataBack(arr, SH As Worksheet)
Dim i As Long, arrInt, El
For Each El In arr
SH.Range(El(1)).value = El(0)
Next
End Sub
Function ExtractData(Rng As Range) As Variant
Dim a As Range, arr, Count As Long, i As Long
ReDim arr(Rng.Cells.Count - 1)
For Each a In Rng.Areas 'creating a jagged array containing the values and the cells address
For i = 1 To a.Cells.Count
arr(Count) = Array(a.Cells(i).value, a.Cells(i).Address(0, 0)): Count = Count 1
Next
Next
ExtractData = arr
End Function
' 在一個單獨的模塊“日歷”中啟動日歷選項顯式選項比較文本
Public PrevVal As Variant, boolDate As Boolean
Sub Basic_Calendar()
Dim datevariable As Variant
datevariable = CalendarForm.GetDate
If datevariable <> 0 Then
PrevVal = Selection.value: boolDate = True
Selection.value = datevariable
End If
End Sub
uj5u.com熱心網友回復：
為了使解決方案允許從 Callendar 進入多個單元格，但也允許多次洗掉，請按以下方式進行調整：
- 在
Basic_CalendarSub存在的模塊中使用此修改后的代碼：
Option Explicit
Option Compare Text
Public PrevVal(), boolDate As Boolean
Sub Basic_Calendar()
Dim datevariable As Variant
datevariable = CalendarForm.GetDate
If datevariable <> 0 Then
PrevVal = Selection.value: boolDate = True
Selection.value = datevariable
Else
Erase PrevVal 'to identify the case of deletion
End If
End Sub
編輯：
如果您的安裝/版本不處理直接加載陣列，請使用下一個版本，通過迭代來完成：
Sub Basic_Calendar()
Dim datevariable As Variant
datevariable = CalendarForm.GetDate
If datevariable <> 0 Then
Dim i As Long
ReDim PrevVal(1 To Selection.Rows.Count, 1 To 1)
For i = 1 To Selection.Rows.Count
PrevVal(i, 1) = Selection.Cells(i).value
Next i
boolDate = True
Selection.value = datevariable
Else
Erase PrevVal 'to identify the case of deletion
End If
End Sub
- 以下一種方式調整這部分
Worksheet_Change事件代碼：
If Target.Cells.Count > 1 Then
If Not CBool(Not Not PrevVal) Then boolDate = False 'the new line checking if the multiple rows array is empty (or not)
TgValue = ExtractData(Target)
Else
TgValue = Array(Array(Target.value, Target.Address(0, 0))) 'Put the target range in an array (or as a string for a single cell)
boolOne = True
End If
修改邏輯如下：
一個。當 Calendar 表單被呼叫并回傳一個 Date 時，在多行范圍內，將交付的datevariable內容放在選定的單元格中，并將其先前的值加載到PrevVal()陣列中；
灣 列“M:M”中的更改會觸發事件，如果PrevVal()不為空，它通常用于插入資料（使用PrevVal()陣列元素而不是UnDo，這不適用于代碼添加的資料）。如果是空陣列，則將boolDate = False代碼切換到 clasic 變體（可以使用UnDo，因為用戶已完成洗掉）...
無需在另一臺 PC 上檢查代碼。這是一個從錯誤假設開始的解決方案邏輯問題，它的作業方式與您的筆記本電腦不同。
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/394321.html