Excel VBA：插入行时随机出现错误1004

Question

我有一个包含一些宏的工作簿，这些宏已经运行了一段时间，直到最近它们才开始显示错误 1004：该命令不能用于多项选择。经过一番头脑风暴后，我发现找出一些隐藏的列和行。

问题： 错误 1004：该命令不能用于多选。

何时：运行删除选定行或插入行的宏。

可能的原因：过滤的行和/或列

InsertRows 模块根据用户提供的数量 (splitVal) 插入 X 行，并从原始 keycell 行复制所有内容、公式和格式。

Sub InsertRows(ByVal splitVal As Integer, ByVal keyCells As Range, ws As Worksheet)

    On Error GoTo ErrorHandler
    PW
    ws.Unprotect Password
    ws.DisplayPageBreaks = False
    WBFast 
    With keyCells
        .Offset(1).Resize(splitVal).EntireRow.Insert
        .EntireRow.Copy .Offset(1, 0).Resize(splitVal).EntireRow 'Error happens here
    End With

ExitHandler:
    ws.Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
    Exit Sub

ErrorHandler:
    WBNorm
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Insert_Rows, line " & Erl & "."
    GoTo ExitHandler

End Sub

-

删除表行模块，删除用户选择的表中的行。在大多数情况下，要删除的结果范围将具有过滤的行，并且可能存在过滤的列。当它到达删除部分时发生错误，与上面的错误相同。

Sub DeleteTableRows()
    'PURPOSE: Delete table row based on user's selection
    'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
    Call PW


    Dim rng As Range
    Dim DeleteRng As Range
    Dim cell As Range
    Dim TempRng As Range
    Dim Answer As Variant
    Dim area As Range
    Dim ReProtect As Boolean
    Dim copyRange As Range
    Dim pasteRange As Range
    Dim wb As Workbook
    Dim a As Long

    WBFast

    'Set Range Variable
      On Error GoTo InvalidSelection
        Set rng = Selection
      On Error GoTo 0


    'Unprotect Worksheet
      With ThisWorkbook.ActiveSheet
        If .ProtectContents Or ProtectDrawingObjects Or ProtectScenarios Then
          On Error GoTo InvalidPassword
          .Unprotect Password
          ReProtect = True
          On Error GoTo 0
        End If
      End With

      Set wb = ThisWorkbook

    'Loop Through each Area in Selection
      For Each area In rng.Areas
        For Each cell In area.Cells.Columns(1)
          'Is selected Cell within a table?
            InsideTable = True

          'Gather rows to delete
            If InsideTable Then
              On Error GoTo InvalidActiveCell
              Set TempRng = Intersect(cell.EntireRow, ActiveCell.ListObject.DataBodyRange)
              On Error GoTo 0

              If DeleteRng Is Nothing Then
                Set DeleteRng = TempRng
              Else
                Set DeleteRng = Union(TempRng, DeleteRng)
              End If

            End If

        Next cell
      Next area


    'Error Handling
      If DeleteRng Is Nothing Then GoTo InvalidSelection
      If DeleteRng.Address = ActiveCell.ListObject.DataBodyRange.Address Then GoTo DeleteAllRows
      If ActiveCell.ListObject.DataBodyRange.Rows.Count = 1 Then GoTo DeleteOnlyRow

    'Ask User To confirm delete (since this cannot be undone)
        DeleteRng.Select

        If DeleteRng.Rows.Count = 1 And DeleteRng.Areas.Count = 1 Then
          Answer = MsgBox("Are you sure you want to delete the currently selected table row? " & _
           " This cannot be undone...", vbYesNo, "Delete Row?")
        Else
          Answer = MsgBox("Are you sure you want to delete the currently selected table rows? " & _
           " This cannot be undone...", vbYesNo, "Delete Rows?")
        End If

    'Delete row (if wanted)
      If Answer = vbYes Then

        'Error 1004 happens here
        For a = DeleteRng.Areas.Count To 1 Step -1
            Debug.Print DeleteRng.Areas.Count
            DeleteRng.Areas(a).EntireRow.Delete
        Next a


        WBNorm

      End If

    'Protect Worksheet
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
    Exit Sub

    'ERROR HANDLERS

InvalidActiveCell:
      MsgBox "The first cell you select must be inside an Excel Table. " & _
       "The first cell you selected was cell " & ActiveCell.Address, vbCritical, "Invalid Selection!"
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
      WBNorm
      Exit Sub

InvalidSelection:
      MsgBox "You must select a cell within an Excel table", vbCritical, "Invalid Selection!"
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
      WBNorm
      Exit Sub

DeleteAllRows:
      MsgBox "You cannot delete all the rows in the table. " & _
       "You must leave at least one row existing in a table", vbCritical, "Cannot Delete!"
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
      WBNorm
      Exit Sub

DeleteOnlyRow:
      MsgBox "You cannot delete the only row in the table.", vbCritical, "Cannot Delete!"
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
      WBNorm
      Exit Sub

InvalidPassword:
      MsgBox "Failed to unlock password with the following password: " & Password
      If ReProtect = True Then wb.Worksheets("Open Orders").Protect Password:=Password, DrawingObjects:=True, Contents:=True, Scenarios:=False _
    , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True, AllowFormattingCells:=True
      WBNorm
      Exit Sub

End Sub

-

Sub WBFast()
    With ThisWorkbook.Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
End Sub

Sub WBNorm()
    With ThisWorkbook.Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

我真的尽了最大的努力想出一种有效的方法来处理这个问题，并且代码直到最近才有效，我发现用户突然需要隐藏列。即使隐藏/过滤了行和列，我必须怎么做才能做我想做的事，从而导致不连续的范围？

取消隐藏和取消过滤是毫无疑问的。用户可以设置复杂的过滤器并隐藏许多他/她不需要的列，我想保留这些东西而不是拿走它们。

关于保存过滤器然后重新应用它们的部分，我尝试了这个宏： In Excel VBA, how do I save / restore a user-defined filter? 但我无法让它工作。

真的没有办法删除不连续范围内的行吗？

Answer 1

我正在使用一个被炸毁的应用程序。很可能它不打算用于这种过度（大量代码和大约 600 张，最终为 14Mb）。它运行良好，直到最近它开始显示 RANDOMLY Error 1004。

取消保护片材接缝作为补救措施：Sheets("Sheet1").Unprotect