我有一个工作簿,其中包含一些非常有效的宏,直到最近他们才开始显示错误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?但我无法使其发挥作用。
真的没有办法删除非连续范围内的行吗?
答案 0 :(得分:0)
我正在使用一个被炸毁的应用程序。很有可能不是为了使用这种多余的代码(很多代码和大约600张纸,最终14Mb)。它运行良好,直到最近它开始显示RANDOMLY Error 1004。
取消保护接缝的保护性措施是:Sheets(“ Sheet1”)。取消保护