Excel VBA 将行号存储在数组中，一次删除多行

Question

我正在尝试删除工作表中在 column B 中具有唯一值的所有行。

我知道这可以通过过滤器或条件格式来完成，但我想知道以下是否也可行，因为它在其他情况下可能有用：

我想遍历所有行并将行号存储在 Array 中（如果该行在 column B 中具有唯一值）。然后在一个操作中删除其编号存储在 Array 中的所有行。

将行号存储在 Array 而不是在循环中删除所需行的原因是为了减少运行时间。

我的数据行数不同，但总是在 column A:K 中，并且总是从第 6 行开始。

下面是我从以下链接获得灵感而编写的代码：
Dynamically adding values to the array on the go.
Deleting rows whose number is stored in array in one single action（参见蒂姆·威廉姆斯的回答）。

我收到错误消息：Run-time error '5': Invalid procedure call or Argument

Sub DeleteRows()
Dim ws4 As Worksheet: Set ws4 = Worksheets("Sheet1")
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupValue
Dim GroupTotal As Long
Dim MyArray()
Dim y As Long

Application.ScreenUpdating = False
ws4.Activate

GroupValue = ws4.Range("B6").Value ' Sets the first GroupValue
CurrentRow = 6 ' Sets the starting row
y = 0
LastRow = ws4.Cells(Rows.Count, "B").End(xlUp).Row

    For x = 1 To LastRow

        GroupTotal=Application.WorksheetFunction.CountIf(Range("B6:B"&LastRow), _
            GroupValue) ' Searches for the GroupValue and finds number of matches
        If GroupTotal = 1 Then ' If GroupTotal = 1 then add the row# to the array
            ReDim Preserve MyArray(y)
            MyArray(y) = CurrentRow
            y = y + 1
        End If

        CurrentRow = CurrentRow + GroupTotal 'set the next row to work with
        GroupValue = Range("B" & CurrentRow).Value 'set next GroupValue to find

        If GroupValue = "" Then ' Checks to see if the loop can stop
            Exit For
        End If

    Next x

'***This should delete all the desired rows but instead produces the error.***
ws4.Range("B" & Join(MyArray, ",B")).EntireRow.Delete
Application.ScreenUpdating = True

End Sub

我已经研究了几个小时并试图操纵代码，但没有成功。

Answer 1

使用定义为 Range 和 Union 每一行的变量。
在下面的示例中，MyArray 是应删除的行号数组。

Public Sub Test()

    Dim MyArray() As Variant

    MyArray = Array(2, 4, 5, 8, 10, 15)

    DeleteRows MyArray

End Sub

Public Sub DeleteRows(RowNumbers As Variant, Optional SheetName As String = "")

    Dim wrkSht As Worksheet
    Dim rRange As Range
    Dim x As Long

    On Error GoTo ERROR_HANDLER

    If SheetName = "" Then
        Set wrkSht = ActiveSheet
    Else
        Set wrkSht = ThisWorkbook.Worksheets(SheetName)
    End If

    For x = LBound(RowNumbers) To UBound(RowNumbers)
        If rRange Is Nothing Then
            Set rRange = wrkSht.Rows(RowNumbers(x))
        Else
            Set rRange = Union(rRange, wrkSht.Rows(RowNumbers(x)))
        End If
    Next x

    If Not rRange Is Nothing Then rRange.Delete

    On Error GoTo 0

Exit Sub

ERROR_HANDLER:
    Select Case Err.Number

        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure DeleteColumns."
            Err.Clear
            Application.EnableEvents = True
    End Select

End Sub

编辑
Test 过程可以替换为创建行号数组的任何代码。然后将该数组传递给 DeleteRows 过程。您还可以向其传递一个 sheet 名称以从以下位置删除行：DeleteRows MyArray, "Sheet2"。

DeleteRows 过程设置变量，打开错误检查，然后检查是否将 sheet 名称传递给它。然后它设置对活动 sheet 或命名 sheet 的引用。您还可以检查传递的 sheet 是否确实存在于此处。

接下来开始循环，从数组的第一个元素到最后一个元素。第一个通常是 0，因此您可以将 LBOUND(RowNumbers) 替换为 0。

rRange 是将保存要删除的行引用的变量，如果它还没有保存范围引用，Union 将不起作用。
在循环的第一遍中，它不会保留引用，因此什么也不是，数组中的第一行将被设置为 wrkSht.[= 中保存的 sheet 的第一行引用。 44=] 在随后的传递中，rRange 将已经包含一个引用，因此下一行将与它合并。
这两个决定是在由 ELSE 语句分隔的 IF...END IF 块中做出的。

循环完成单行 IF 语句后 - 单行不需要 END IF - 检查 rRange 是否包含任何引用。如果是这样，那么这些行将被删除。

程序退出代码主体，处理错误处理后结束。

Excel VBA 将行号存储在数组中，一次删除多行

Excel VBA Store row numbers in Array and delete multiple rows at once

excel

vba

delete-row