vba - Excel VB 错误 Application.Undo & ActiveSheet.Protect

Question

好奇是否有人对此有解决方案。下面是我的代码，我认为它运行良好。我们使用了很长时间，其他人向我指出他们一直在做的事情，这导致了脚本错误。

这段代码的作用是防止某人一次更新多个单元格。如果有人复制了大量数据，在 Excel 中粘贴时占用了多于一行或一列，例如处理一封电子邮件并将其粘贴到电子表格中，则会收到一个弹出警报，提示不要更改多个单元格一次，然后它会撤消粘贴。这部分效果很好。

有人在做什么，这会导致错误，他们会选择一个单元格，并且它在单元格的右下角有那个正方形，您可以单击并拖动以填充或填充，他们会选择它并填充.如果只向下填写一个单元格，则没有问题。问题是当他们对两个或更多单元执行此操作时，即发生错误。更具体地说，在 Application.Undo 的行上.

所以问题真的不在于 Application.Undo 行。 ，实际上是电子表格被锁定。如果我要删除 ActiveSheet.Unprotect 的行和 ActiveSheet.Protect然后代码工作正常。但是，我确实希望它受到保护。这里的代码比我这里的代码多得多，但这只是其中的一个片段，我确实正确格式化了单元格，因此正确的单元格被锁定，而其他的则没有。您应该能够获取代码并将其粘贴到新的电子表格中，它会起作用，因此您可以看到我在说什么，但是，请确保先解锁一些单元格，以便可以对其进行编辑。执行此操作以查看错误后，请删除保护/取消保护行以重试，代码将正常工作。

如果有人对此有解决方案，请告诉我，以便我仍然可以保护电子表格，并感谢您的帮助!

    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

Answer 1

好吧，我现在觉得有点傻。我弄清楚了这个问题。不敢相信花了这么长时间。由于我的代码的后半部分，电子表格受到保护，我有它突出显示它所在行的部分。我不得不将 Target.Count 部分移到该子标题的顶部。所以 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