一次删除行40k +行的速度更快 [英] Faster way to delete rows 40k+ rows at once

问题描述

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

p>

下面的代码工作很慢：

  Dim toDelete As Range 
对于icount = endRow到3步骤-2 
如果toDelete不是，然后
设置为删除=行（icount）
 Else 
设置为删除=联合（toDelete，Rows icount））
结束如果
下一个
 toDelete.Delete shift：= xlUp 
  

解决方案

我已经发布了此解决方案，但它是在一个范围（地址）投掷的上下文中地址的错误超出了一些长度。

但现在主题是严格删除许多行的最快方法和我LL假设它需要坚持实际删除行（即所以我会在这里再次发布这个解决方案（在按地址删除方法的标题下）以及一个第二个（按排序删除方法）要快得多（第一次需要大约20秒，第二次需要大约0.2秒来处理大约40k行，即删除20k行）

两个解决方案在OP 之后稍微专门为icount = endRow到3 Step -2 的东西，但它可以很容易地变得更一般的

---

按地址删除方式

  Option Explicit 
 
 Sub main（）
 Dim icount As Long，endrow As Long 
 Dim strDelete As String 
 
使用Worksheets（Delete）
对于icount = .Cells（.Rows.Count，C）。End（xlUp）.Row To 3 Step -2 
 strDelete = strDelete& ，& icount& ：& icount 
下一个icount 
结束
 
 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 
循环
如果Len（partialAddress& arr（iArr））< = 250然后
 partialAddress = partialAddress& arr（iArr）
 iArr = iArr + 1 
 Else 
 partialAddress = Left（partialAddress，Len（partialAddress） -  1）
 End If 
 Range（partialAddress）删除shift：= xlUp 
循环
 End Sub 
  

---

删除bySort方法

  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））
与.UsedRange 
 .Sort key1：=。列（.Columns.Count），标题：= xlNo 
设置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 
 
函数GetArray（nRows As Long，iniRow As Long）
 Dim我长了
 
 ReDim arr（1 to nRows）As Long 
 For i = 1 To nRows 
 arr（i）= i 
 Next i 
对于i = nRows To iniRow Step -2 
 arr（i）= nRows + 1 
下一个i 
 GetArray = arr 
结束函数
  

Is there a faster way to delete rows ?

I just need to delete rows with odd row numbers from row 3 to the last row with data in it

Below code works but is very slow:

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

解决方案

I already posted this solution, but it was in the context of a Range(address) throwing errors when address exceeded some length.

But now the topic is strictly that of the fastest way to delete many rows and I'll assume it's required to stick to actually delete rows (i.e. mantaining formatting, formulas, formula references...)

So I'll post here that solution again (under the header of "Delete by Address" approach) along with a 2nd one ("Delete by Sort" approach) which is much much faster (1st takes some 20 secs, 2nd takes some 0,2 secs to process some 40k rows, i.e. delete 20k rows)

Both solutions are slightly specialized after the OP For icount = endRow To 3 Step -2 thing, but it can be easily made more general

---

"Delete by Address" approach

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

---

"Delete bySort" approach

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

这篇关于一次删除行40k +行的速度更快的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！