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

VBA_Loop通过范围中的空行并删除所有批处理（一行）

1 个答案: