Excel VBA Сохранение номеров строк в массиве и удаление нескольких строк одновременно

Question

Я пытаюсь удалить все строки на моем листе, которые имеют уникальное значение в column B.

Я знаю, что это можно сделать с помощью фильтра или условного форматирования, но я хотел бы знать, возможно ли следующее, так как это может быть полезно в других ситуациях:

Я хочуцикл по всем строкам и сохранение номера строки в Array, если строка имеет уникальное значение в column B.Затем удалите все строки, чей номер хранится в Array, одним действием.

Причина сохранения номеров строк в Array вместо удаления нужных строк в цикле заключается в сокращении времени выполнения.

Мои данные различаются по количеству строк, но всегда находятся в column A:K и всегда начинается в строке 6.

Ниже приведен код, который я вдохновил по следующим ссылкам:
Динамическое добавление значений в массив на ходу .
Удаление строк, чей номер хранится в массиве, одним действием (см. Ответ Тима Уильямса).

Я получаю сообщение об ошибке: 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.Вы также можете передать ему имя листа для удаления строк из: DeleteRows MyArray, "Sheet2".

Процедура DeleteRows устанавливает переменные, включает проверку ошибок и затем проверяет, было ли ей передано имя листа.Затем он устанавливает ссылку либо на активный лист, либо на именованный лист.Вы также можете проверить, существует ли переданный лист здесь.

Далее цикл начинается с первого до последнего элемента массива.Первый обычно равен 0, поэтому вы можете заменить LBOUND(RowNumbers) на 0.

rRange - это переменная, которая будет содержать ссылки на строки для удаления, и Union не будет работать, если она еще не содержит ссылку на диапазон.
При первом проходе циклаон не будет содержать ссылку, поэтому будет ничем, и первая строка в массиве будет установлена ​​как ссылка на первую строку на листе, хранящемся в wrkSht.
При последующих проходах rRange уже будет содержать ссылку, так чтоследующая строка будет объединена с ним.
Эти два решения принимаются в блоке IF...END IF, отделенном оператором ELSE.

После завершения цикла в одной строке оператор IF - в одной строке не требуется END IF - проверяет, содержит ли rRange какие-либо ссылки.Если это так, то эти строки будут удалены.

Процедура выходит из основной части кода, обрабатывает ошибки и затем завершается.