2
好奇，如果有人有解決這個問題。下面是我的代碼，我認爲它工作正常。我們已經使用了很長時間，有人向我指出他們一直在做的事情，這會導致腳本錯誤。Excel VB錯誤Application.Undo＆ActiveSheet.Protect
該代碼的功能是防止某人一次更新多個單元格。如果有人複製一大塊數據，並粘貼到Excel中時佔用多行或多列，例如應對電子郵件並將其粘貼到電子表格中，則會收到一個彈出式警報，指出不會更改多個單元格在一次，然後它將撤消粘貼。這部分工作很好。
某人正在做什麼導致錯誤，他們會選擇一個單元格，並在單元格右下角有一個正方形，您可以點擊並拖動以填滿或者覆蓋，他們會選擇並填補下來。如果只填充一個單元格，則不存在問題。問題是當他們對兩個或更多個單元執行此操作時，即發生錯誤時。更具體地說，就是Application.Undo。
所以這個問題真的不是線Application.Undo，它實際上是電子表格被鎖定。如果我想刪除表示ActiveSheet.Unprotect和ActiveSheet.Protect的行，那麼代碼工作正常。不過，我確實希望它受到保護。還有更多的代碼，然後我在這裏，但這只是它的一個片段，我確實格式正確，所以正確的單元格被鎖定，其他單元格不是。你應該能夠把代碼粘貼到一個新的電子表格中，它可以工作，所以你可以看到我在說什麼，但是，確保你先解鎖一些單元格，以便編輯它們。一旦你這樣做了，看到錯誤，請將Protect/unprotect行刪除以再次嘗試，並且代碼無任何問題。
請讓我知道如果有人有解決方案，所以我仍然可以保持電子表格的保護，並感謝您的幫助！
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim vClear As Variant
Dim vData As Variant
Dim lFirstRow As Long
Dim lLastRow As Long
'This prevents more than one cell from being changed at once.
'If more than one cell is changed then validation checks will not work.
If Target.Cells.Count > 1 Then
vData = Target.Formula
For Each vClear In vData
If vClear <> "" Then 'If data is only deleted then more than one cell can be changed.
MsgBox "Change only one cell at a time", , "Too Many Changes!"
Application.Undo
Exit For
Else
'If data is deleted this will check to see what columns are being deleted.
'Deleting certain columns will also allow for the automatic deletion of other columns not selected.
If vClear = "" Then
'If the target includes columns D, it will also clear columns M & N.
If Not Intersect(Target, Columns("D")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column M & N.
ActiveSheet.Range(Cells(lFirstRow, 13), Cells(lLastRow, 13)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns G, it will also clear columns I & K & N.
If Not Intersect(Target, Columns("G")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K & N.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns H, it will also clear columns I & K.
If Not Intersect(Target, Columns("H")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
'If the target includes column J, it will also clear column K.
If Not Intersect(Target, Columns("J")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column K.
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
End If
End If
Next
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim iFirstCol As Integer
Dim iLastCol As Integer
Dim iFirstRow As Integer
Dim iLastRow As Integer
Dim iColor As Integer
'''Only adjust the below numbers to fit your desired results.'''
iFirstCol = 1 'Change this number to the number of the first column that needs to be highlighted. Column A = 1.
iLastCol = 15 'Change this number to the number of the last column that needs to be highlighted. Column A = 1.
iFirstRow = 7 'Change this number to the number of the first row that needs to be highlighted.
iLastRow = 500 'Change this number to the number of the last row that needs to be highlighted.
iColor = 20 'Change this number to use a different highlight color.
'''End of changes, do not change anything else.'''
If Target.Count = 1 Then
'The row highlight will only be applied if the selected range is within this if statement criteria.
If Target.Row > iFirstRow - 1 And Target.Row < iLastRow + 1 And Target.Column > iFirstCol - 1 And Target.Column < iLastCol + 1 Then
'Resets the color within the full range when cell selection changed.
ActiveSheet.Range(ActiveSheet.Cells(iFirstRow, iFirstCol), ActiveSheet.Cells(iLastRow, iLastCol)).Interior.Color = xlNone
'Applies the colors to the row.
For counter = iFirstCol To iLastCol
With ActiveSheet.Cells(Target.Row, iFirstCol).Interior
.ColorIndex = iColor
.Pattern = xlSolid
End With
iFirstCol = iFirstCol + 1
Next counter
End If
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
拖動允許用戶嗎？如果拖動導致此問題，爲什麼不禁用單元格拖動？ –
是的，如果他們拖動到一個單元格以允許單個更改，但它並不是真的需要，但如果用戶更喜歡使用它，則可以。如果沒有其他的選擇，我可以禁用它，儘管我不確定你能否確認它，但是有點想到同樣的事情，並且想到查找可能的代碼來禁用它。我寧願這是最後的手段。如果你應該知道如何禁用它，如果我應該走這條路線，你可以發佈代碼嗎？這將是我的最後一個選擇。謝謝 – Chris
'應用程序。CellDragAndDrop = False'，並且不確定爲什麼當有一個簡單的可用解決方案時，你試圖尋找一個困難的解決方案。你的整個想法更多的是允許用戶單獨進入到工作表上。不是嗎？ –