好奇，如果有人有解决方案。这是我下面的代码，我认为它工作得很好。我们使用它很长一段时间，其他人一直向我指出他们做的事情，这会导致脚本错误。
此代码的作用是阻止某人一次更新多个单元格。如果有人复制了大量数据，当它粘贴到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
答案 0 :(得分：0)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)之前的所有内容都没有改变，但之后我必须修改它检查选择了多少个单元格的位置，以防止电子表格受到保护。显然，当你向下拖动时，它有点像单独选择单元格而同时选择所有单元格。这就是为什么当我在电子表格中粘贴数据时代码工作没有错误，因为它只会读取SelectionChange类别一次，但如果我向下拖动它将在每次向下拖动时读取此部分。我以前不知道，但我想这一定是它的工作方式。
所以我只是在SelectionChange部分修改了代码，现在它可以工作了。还要感谢为我留下评论和建议的每个人。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge = 1 Then
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.'''
'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
ActiveSheet.Protect
Application.EnableEvents = True
End If
End Sub