vba - 一次删除 40k+ 行的更快方法

Question

有没有更快的删除行的方法？

我只需要从第 3 行到包含数据的最后一行删除具有奇数行号的行

下面的代码有效，但速度很慢:

Dim toDelete As Range
For icount = endRow To 3 Step -2
    If toDelete Is Nothing Then
        Set toDelete = Rows(icount)
    Else
        Set toDelete = Union(toDelete, Rows(icount))
    End If
Next
toDelete.Delete shift:=xlUp

Answer 1

我已经发布了this solution , 但它是在 Range(address) 的上下文中在 address 时抛出错误超过了一些长度。

但现在这个主题严格来说是删除许多行的最快方法，我假设它需要坚持实际删除行(即维护格式、公式、公式引用......)

因此，我将再次在此处发布该解决方案(在“按地址删除”方法的标题下)以及第二个(“按排序删除”方法)，它要快得多(第一个需要大约 20 秒，第二个需要大约 0 ,2 秒处理大约 40k 行，即删除 20k 行)

在 OP For icount = endRow To 3 Step -2 之后，这两种解决方案都略微特化。东西，但它可以很容易地变得更通用

“按地址删除”方法

Option Explicit

Sub main()    
    Dim icount As Long, endrow As Long
    Dim strDelete As String

    With Worksheets("Delete")
        For icount = .Cells(.Rows.Count, "C").End(xlUp).Row To 3 Step -2
            strDelete = strDelete & "," & icount & ":" & icount
        Next icount
    End With

    DeleteAddress Right(strDelete, Len(strDelete) - 1)        
End Sub

Sub DeleteAddress(ByVal address As String)
    Dim arr As Variant
    Dim iArr As Long
    Dim partialAddress As String

    arr = Split(address, ",")
    iArr = LBound(arr)
    Do While iArr < UBound(arr)
        partialAddress = ""
        Do While Len(partialAddress & arr(iArr)) + 1 <= 250 And iArr < UBound(arr)
            partialAddress = partialAddress & arr(iArr) & ","
            iArr = iArr + 1
        Loop
        If Len(partialAddress & arr(iArr)) <= 250 Then
            partialAddress = partialAddress & arr(iArr)
            iArr = iArr + 1
        Else
            partialAddress = Left(partialAddress, Len(partialAddress) - 1)
        End If
        Range(partialAddress).Delete shift:=xlUp
    Loop
End Sub

“按排序删除”方法

Option Explicit

Sub main()
    Dim nRows As Long
    Dim iniRng As Range

    With Worksheets("Delete")
        nRows = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Cells(1, .UsedRange.Columns(.UsedRange.Columns.Count + 1).Column).Resize(nRows) = Application.Transpose(GetArray(nRows, 3))
        With .UsedRange
            .Sort key1:=.Columns(.Columns.Count), Header:=xlNo
            Set iniRng = .Columns(.Columns.Count).Find(what:=nRows + 1, LookIn:=xlValues, lookat:=xlWhole)
            .Columns(.Columns.Count).ClearContents
        End With
        .Range(iniRng, iniRng.End(xlDown)).EntireRow.Delete
    End With   
End Sub

Function GetArray(nRows As Long, iniRow As Long)
    Dim i As Long

    ReDim arr(1 To nRows) As Long
    For i = 1 To nRows
        arr(i) = i
    Next i
    For i = nRows To iniRow Step -2
        arr(i) = nRows + 1
    Next i
    GetArray = arr
End Function