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

时间:2018-05-25 21:18:29

标签: excel vba excel-vba

我有一个工作簿,其中包含一些非常有效的宏,直到最近他们才开始显示错误1004:该命令不能用于多个选择。经过一些头脑风暴后,我找到了出了一些隐藏的列和行。

问题:错误1004:该命令无法用于多项选择。

何时:运行删除所选行或插入行的宏。

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

InsertRows模块插入X行,具体取决于用户提供的数字(splitVal),并从原始的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?但我无法使其发挥作用。

真的没有办法删除非连续范围内的行吗?

1 个答案:

答案 0 :(得分:0)

我正在使用一个被炸毁的应用程序。很有可能不是为了使用这种多余的代码(很多代码和大约600张纸,最终14Mb)。它运行良好,直到最近它开始显示RANDOMLY Error 1004。

取消保护接缝的保护性措施是:Sheets(“ Sheet1”)。取消保护