我有兩個代碼取決于要運行的應用程式事件。
Code (1) 如果 ActiveSheet 的任何列上的 FilterMode 為 True，則更改 column_A 的顏色。
Code (2) 記錄 ActiveSheet 中任何單元格的更改并放入另一個作業表（“日志”）。
如果出現錯誤：Filtermode = False 并且任何單元格被填充句柄（所選單元格右下角的小方塊）更改，我收到此錯誤
Method 'Undo' of object '_Application' failed
在Application.Undo代碼 (2)上的這一行。我嘗試使用代碼 (1) 禁用和啟用事件，但沒有運氣。
任何幫助將不勝感激。
Option Compare Text
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
'Code (1) change color of column_A If FilterMode is True on any column of active sheet.
Dim Column_A As Range
Set Column_A = ActiveSheet.Range("A3", ActiveSheet.Range("A" & ActiveSheet.Rows.count).End(xlUp))
If ActiveSheet.FilterMode = True Then
Column_A.Interior.Color = RGB(196, 240, 255)
Else 'FilterMode = False
Column_A.Interior.Color = RGB(255, 255, 255)
End If
End Sub
' Code (2) Log Changes of Current Sheet and put in Sheet("Log")
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue
Dim sh As Worksheet: Set sh = Sheets("Log")
Dim UN As String: UN = Environ$("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
Application.Undo
RangeValues = extractData(Target) 'Define RangeValue
putDataBack TgValue, ActiveSheet 'Reinsert changed data
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))
'Array("User Name", "Date,Time", "Work Order", "Column Label", "New Value", "Old Value")
Range(RangeValues(r)(1)).EntireRow.AutoFit
If Range(RangeValues(r)(1)).RowHeight < 53 Then
Range(RangeValues(r)(1)).RowHeight = 53
End If
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
uj5u.com熱心網友回復：
我想出了這個問題，雖然代碼 (2) Worksheet_Change 事件引發了錯誤，
但實際上SelectionChange event代碼（1）才是真正的問題。
顯然，當我向下拖動時，有點像單獨選擇單元格并同時選擇所有單元格。
為了解決這個問題，必須在事件 SelectionChange 中添加一個條件來計算目標單元格：
If Target.Cells.CountLarge = 1 then
所以我只是在 SelectionChange 部分修改了代碼，現在它可以完美運行。
'Code (1)
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Cells.CountLarge = 1 Then
Dim Column_A As Range
Set Column_A = ActiveSheet.Range("A3", ActiveSheet.Range("A" & ActiveSheet.Rows.count).End(xlUp))
If ActiveSheet.FilterMode = True Then
Column_A.Interior.Color = RGB(255, 0, 0)
Else 'FilterMode = False
Column_A.Interior.Color = RGB(255, 255, 255)
End If
End If
End Sub
與此同時，我了解到Calculate event將更改捕獲到此鏈接中所述的過濾串列是最佳選擇
https://www.experts-exchange.com/articles/2773/Trapping-a-change-to-a-filtered-list-with-VBA.html
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/336061.html