VBA_Loop遍歷一個范圍中的空行並批量刪除所有行（一行）

Question

我已經開發了下面的代碼，該代碼循環遍歷usedrange，將行字符串存儲到20個元素的數組中，然后刪除行尾，因為在給定大量代碼的情況下，這比FOR或DO循環要快得多行。 該代碼有效，但是，問題在於這樣的事實，當將行寫入數組元素時，它們將被硬編碼，並且當使用.DELETE方法時，行會相應移動，因此數字會移動並且不會刪除所有內容。

有沒有辦法刪除一批或一行中的范圍數組，類似

Arr(drows(1 to 20)).delete

還是我必須找到其他選擇？

'**** NEEDS RE-WORK --> ADJUST FOR ROWS WHEN DELETING ****'

    Sub loop_it()
    Dim i As Integer        'counter for array
    Dim j As Integer        'counter # 2
    Dim rD As Integer       'count deleted
    Dim z As Integer
    Dim dRows(20) As String 'will track the rows deleted1
    Dim cRow As Range       'current row
    Dim cSht As Worksheet
    Dim uB As Integer
    Set cSht = ActiveSheet  'activesheet
    i = 1: j = 1: z = 1
    On Error GoTo viewerr
    For Each cRow In cSht.UsedRange.Rows
        If WorksheetFunction.CountA(cRow.Cells) = 0 Then
            If Len(dRows(i)) < 250 Then             'not to breach length
            dRows(i) = dRows(i) & cRow.Row & ":" & cRow.Row & ","
            rD = rD + 1                 'increment # rows deleted
            Else
            dRows(i) = dRows(i)         'nothing
            i = i + 1
            End If
        End If
    Next cRow

    uB = UBound(dRows)                  'max array

    For j = 1 To uB
        If j <= i Then                                      'skip empty strings
        dRows(j) = Left(dRows(j), Len(dRows(j)) - z)       ' trim last comma off of string
        cSht.Range(dRows(j)).Delete                         'delete the rows
        Else
        Exit For
        End If
    Next j

    'need to combine the text string into one array

    MsgBox rD & Chr(32) & "rows deleted!", vbExclamation + vbOKOnly, "success!"
    Erase dRows             'clear array

    Exit Sub
    viewerr:
    MsgBox Err.Description & Space(2), vbCritical
    Erase dRows

    End Sub

Answer 1

以下是通常為此任務建議的內容：

Sub Tester()
    '...
    '...
    Dim rngDelete As Range

    For Each cRow In cSht.UsedRange.Rows
        If WorksheetFunction.CountA(cRow.Cells) = 0 Then
            If rngDelete Is Nothing Then
                Set rngDelete = cRow.EntireRow
            Else
                Set rngDelete = Application.Union(rngDelete, cRow.EntireRow)
            End If
        End If
    Next cRow

    'delete rows if any found
    If Not rngDelete Is Nothing Then rngDelete.Delete

End Sub