excel - VBA宏通过特定单元格值过滤表格并删除所有行

Question

我的宏的目的是执行以下步骤： 1：过滤表查看 D 列以检索所有“0”值 2：删除所有具有“0”值的行 3：删除过滤器。

问题是我的表有 75,000 多行数据，所以我不断收到警报说我有太多数据。我尝试了一个循环宏，但执行这项工作需要很长时间，所以我现在正在研究一个执行上述步骤的宏。我的代码不断挂断以删除我选择的单元格范围。（我的范围超出了表格范围，因为该表格将始终具有可变数量的行）。

错误：“oject'_Worksheet' 的方法 'Range' 失败

我假设我需要指定表中的确切行数。如何更改代码以便不必在每次执行宏时都更改范围？

这是我到目前为止所拥有的：

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

标签： excelvbafilterdatatable

Answer 1

修改数组中的范围

• 以下代码仅适用于范围内的值，而不是公式。如果有公式，将返回值。

• 下面的代码会将整个范围复制到一个数组中，它将检查每一行的条件，如果没有找到，将（覆盖）写入同一个数组，导致数组太大，但随后可能会出现 3 个中的 1 个方式（cWriteDelete）写回范围：

  1. 它会将空字符串 ( "" ) 写入数组的其余部分并将其粘贴回范围。
  2. 它会将数组原样复制到范围中并删除不必要的行。
  3. 它会将数组原样复制到范围中并删除不必要的范围。

• 为什么不调整数组的大小？

  该数组是一个二维数组，我们无法调整其第一个维度（行）的大小。

编码

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