我的宏的意图是执行以下步骤： 1：过滤器表查看D列以检索所有“ 0”值 2：删除所有值为“ 0”的行 3：卸下过滤器。
问题是我的表有75,000+数据行，所以我不断收到警报，说我有太多数据。我尝试了一个循环宏，但是执行该工作花费的时间太长，所以我现在正在执行执行上述步骤的宏。我的代码一直挂在网上，以删除我选择的单元格范围。 （我的范围超出了表范围，因为该表将始终具有可变数量的行）。
错误：“对象'_Worksheet'的方法'范围'失败
我假设我需要在表中指定确切的行数。如何更改代码，以免每次执行宏时都不必更改范围？
这是我到目前为止所拥有的：
Sub Delete_Zero_Rows()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Status")
ws.Activate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
ws.Range("B3:F1").AutoFilter Field:=4, Criteria1:="0"
Application.DisplayAlerts = False
ws.Range("B4:F").SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
End Sub
答案 0 :(得分：0)
一个循环应该可以很好地处理75,000行。关闭屏幕更新以加快速度。试试这个：
Sub DeleteZeroRows()
Dim LastRow As Long, n As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For n = LastRow To 1 Step -1
If Cells(n, 5).Value = 0 Then Cells(n, 5).EntireRow.Delete
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
请注意，我正在向后退（从下往上），所以当删除行并向上移动行时，它不会更改您在下一个循环迭代中移至的行号。
还要注意Cells(n, 5)，其中5是列（“ E”），也是我要寻找零的位置。
答案 1 :(得分：0)
如果要过滤“ D”列，则是从“ B”列开始的第三个
Sub Main
With ThisWorkbook.Worksheets("Status")
.ShowAllData
With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp))
.AutoFilter Field:=3, Criteria1:="0"
On Error Resume Next
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete
On Error GoTo 0
End With
.AutofilterMode = False
End With
End Sub
答案 2 :(得分：0)
以下代码将整个范围复制到一个数组中，在该数组中
将检查每一行的条件，如果找不到，将
（覆盖）写入同一数组导致数组过大，但是会
然后以3种可能的方式之一（cWriteDelete）写回
范围：
为什么不调整数组大小？
该数组是 2D 数组，我们无法调整其第一维（行）的大小。
Sub Delete_Zero_Rows()
Const cSheet As String = "Status" ' Worksheet Name
Const cRange As String = "A:F" ' Source Columns Range Address
Const cFR As Long = 4 ' First Row Number
Const cCol As Variant = "E" ' Criteria Column Letter/Number
Const cCrit As Long = 0 ' Criteria
Const cWriteDelete As Long = 2 ' 1 - Write "" to array
' 2 - Delete remaining rows
' 3 - Delete remaining range
Dim Rng As Range ' Last Used Cell Range In Criteria Column,
' Source/Target Range
Dim vntST As Variant ' Source/Target Array
Dim ACC As Long ' Array Criteria Column Number
Dim i As Long ' Source Array Row Counter
Dim j As Long ' Source/Target Array Column Counter
Dim k As Long ' Target Array Row Number (Counter)
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
On Error GoTo ProcedureExit ' Safely exit program.
With ThisWorkbook.Worksheets(cSheet)
'************************************************
' Last Used Cell Range in Criteria Column (Rng) '
'************************************************
' Calculate Last Used Cell Range in Criteria Column.
Set Rng = .Columns(cCol).Find("*", , xlFormulas, _
xlWhole, xlByColumns, xlPrevious)
' Check if all cells in Criteria Column (cCol) are empty i.e. Last Used
' Cell Range in Criteria Column (Rng) is Nothing.
If Rng Is Nothing Then ' Inform user.
MsgBox "No Data in Column '" & Split(.Cells(1, cCol).Address, _
"$")(1) & "'.", vbInformation, "Empty Column"
GoTo ProcedureExit ' Safely exit program.
End If
'******************************
' Source (Target) Range (Rng) '
'******************************
' Calculate Source/Target Range (Rng) from Source Columns Range(cRange).
Set Rng = .Columns(cRange).Resize(Rng.Row - cFR + 1).Offset(cFR - 1)
' Copy Source/Target Range (Rng) to Source/Target Array (vntST).
vntST = Rng
'******************************
' Source/Target Array (vntST) '
'******************************
' Calculate Array Criteria Column Number.
ACC = .Columns(cCol).Column
' Loop through rows (i) of Source/Target Array (vntST).
For i = 1 To UBound(vntST)
' Check if value of current row (i) in Array Criteria Column (ACC)
' does not equal to Criteria (cCrit).
If vntST(i, ACC) <> cCrit Then
' Count (add 1 to) Target Array Row Number (k).
k = k + 1
' Loop through columns(j) of Source/Target Array (vntST).
For j = 1 To UBound(vntST, 2)
' Write from current row(i) in column(j) to current row(k)
' in column (j) of Source/Target Array (vntST).
' Note: Data is being overwritten since always k <= j.
vntST(k, j) = vntST(i, j)
Next
End If
Next
' Check if Target Array Row Number is equal to the number of rows in
' Source/Target Array (or in Source/Target Range).
If k = UBound(vntST) Then ' or k = Rng.Rows.Count; Inform user.
MsgBox "No cell containing '" & cCrit & "' in Column '" _
& Split(.Cells(1, cCol).Address, "$")(1) & "' found.", _
vbInformation, "Nothing Changed"
GoTo ProcedureExit ' Safely exit program.
End If
Select Case cWriteDelete
Case 1 ' Slower version.
' Loop through the remaining rows (i) of Source/Target
' Array (vntST) starting from the current Target Array Row
' Number (k) increased by 1 (next).
For i = k + 1 To UBound(vntST)
' Loop through columns(j) of Source/Target Array (vntST).
For j = 1 To UBound(vntST, 2)
' Write empty strings ("") to current row(i) in
' column (j) of Source/Target Array (vntST)
vntST(i, j) = ""
Next
Next
'******************************
' Target (Source) Range (Rng) '
'******************************
' Copy completely modified Source/Target Array (vntST)
' to Source/Target Range (Rng).
Rng = vntST
Case 2 ' Faster Version.
'******************************
' Target (Source) Range (Rng) '
'******************************
' Copy not completely modified Source/Target Array (vntST)
' to Source/Target Range (Rng).
Rng = vntST
' Delete remaining (not modified) rows greater than current
' Target Array Row Number (k) increased by First Row (cFR),
' i.e. starting from the calculated row:
' (k + 1) + (cFR - 1) = k + cFR.
.Rows(k + cFR & ":" & Rng.Rows.Count + cFR - 1).Delete
Case 3 ' Faster Version.
'******************************
' Target (Source) Range (Rng) '
'******************************
' Copy not completely modified Source/Target Array (vntST)
' to Source/Target Range (Rng).
Rng = vntST
' Delete remaining (not modified) range.
.Columns(cRange).Resize(Rng.Rows.Count - k) _
.Offset(k + cFR - 1).Delete ' Clear, ClearContents
Case Else
End Select
End With
ProcedureExit:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub