vba - Excel VBA:插入行时随机出现错误1004
问题描述
我有一个包含一些宏的工作簿,这些宏已经运行了一段时间,直到最近它们开始显示错误 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
我真的尽了最大的努力来用一种有效的方法来处理这个问题,并且代码直到最近才起作用,我发现用户突然需要隐藏列。即使有隐藏/过滤的行和列,我必须做什么,做我想做的事,导致不连续的范围?
取消隐藏和取消过滤是毫无疑问的。用户可以设置复杂的过滤器并隐藏许多他/她不需要的列,我想保留这些东西而不是拿走它们。
关于保存过滤器然后重新应用它们的部分,我尝试了这个宏: 在 Excel VBA 中,如何保存/恢复用户定义的过滤器?但我无法让它工作。
真的没有办法删除非连续范围内的行吗?
解决方案
我正在使用一个被炸毁的应用程序。很可能它不打算用于这种多余的(大量代码和大约 600 张,最终为 14Mb)。它运行良好,直到最近它开始显示 RANDOMLY Error 1004。
取消保护片材接缝作为补救措施:Sheets("Sheet1").Unprotect
推荐阅读
- amazon-web-services - 无法通过 RDS 代理连接到 RDS PostgreSQL 数据库实例
- ajax - .Net Core Razor 页面 - 后不显眼的 ajax 后刷新字段
- javascript - 基于水平滚动位置的纯javascript隐藏和显示导航箭头
- ansible - 使用 Ansible shell 模块和gather_facts:不安全吗?
- java - Java 库的急切初始化
- javascript - 如何使用基于先前选择的字典列表填充下拉菜单?
- sorting - Jekyll/liquid 代码中基于两列的排序
- arrays - 带有数组参数的 const 声明?
- elasticsearch - 当涉及特殊字符时,Elasticseach 查询过滤器/术语不起作用
- asynchronous - 有人知道如何使用 Microsoft.SqlServer.Management.Smo.Table 异步创建表吗?