Effizienteste Weg, um Zeile löschen mit VBA

Die kurze Antwort:

Etwas wie

ActiveSheet.Range(DelStr).Delete
' where DelStr = "15:15" if you want to delete row 15
'              = "15:15,20:20,32:32" if you want to delete rows 15,20 and 32

Die lange Antwort:

Wichtig: Wenn Sie ~ 30 /35 Zeilen zu löschen, wird der folgende code funktioniert sehr effizient. Darüber hinaus wäre es werfen einen Fehler. Für code zu handhaben beliebige Anzahl von Zeilen effizient sehen die sehr lange Antwort unten.

Wenn Sie eine Funktion, die können Sie die Liste der Zeilen, die Sie löschen möchten, versuchen Sie den folgenden code ein. Dies ist, was ich verwenden, um sehr effizient zu löschen mehrere Zeilen mit minimalem overhead. (das Beispiel geht davon aus, dass Sie erreicht haben die Zeilen, die Sie löschen müssen, um durch einige Programm, hier habe ich manuell füttern):

Sub DeleteRows()
    Dim DelRows() As Variant
    ReDim DelRows(1 To 3)

    DelRows(1) = 15
    DelRows(2) = 18
    DelRows(3) = 21

    '--- How to delete them all together?

    Dim i As Long
    For i = LBound(DelRows) To UBound(DelRows)
        DelRows(i) = DelRows(i) & ":" & DelRows(i)
    Next i

    Dim DelStr As String
    DelStr = Join(DelRows, ",")

    ' DelStr = "15:15,18:18,21:21"
    '           
    '    IMPORTANT: Range strings have a 255 character limit
    '    See the other code to handle very long strings

    ActiveSheet.Range(DelStr).Delete
End Sub

Die (sehr lange) effiziente Lösung für eine beliebige Anzahl von Zeilen und die benchmark-Ergebnisse:

Hier sind die benchmark Ergebnisse, die durch die Zeilen löschen (Zeit in Sekunden vs. keine. der Zeilen).

Den Zeilen auf einem sauberen Blatt und enthalten eine flüchtige Formel in der Spalte D von D1:D100000

d.h. für 100.000 Zeilen, Sie haben eine Formel =SIN(RAND())

Der code ist nicht lang und nicht allzu hübsch, aber es spaltet die DelStr in 250 Zeichen, Zeichenketten und bildet eine Reihe mit diesen. Dann wird der neue DeleteRng Bereich gelöscht wird, in einem einzigen Arbeitsgang.

Zeit löschen kann, hängt von den Inhalten der Zellen. Die Tests/benchmarking, in Kongruenz mit ein bisschen intuition schlägt vor, die folgenden Ergebnisse.

• Sparse rows/leere Zellen löschen schnellsten
• Zellen mit Werten, die etwas länger dauern
• Zellen mit Formeln auch länger dauern
• Zellen, die feed-in-Formeln in anderen Zellen, die dauern am längsten, da Ihre Streichung löst das #Ref - Verweis-Fehler.

Code:

Sub DeleteRows()

    ' Usual optimization
    ' Events not disabled as sometimes you'll need to interrupt
    ' You can optionally keep them disabled

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    ' Declarations...

    Dim DelRows() As Variant

    Dim DelStr As String, LenStr As Long
    Dim CutHere_Str As String
    Dim i As Long

    Dim MaxRowsTest As Long
    MaxRowsTest = 1000

    ' Here I'm taking all even rows from 1 to MaxRowsTest
    ' as rows to be deleted

    ReDim DelRows(1 To MaxRowsTest)

    For i = 1 To MaxRowsTest
        DelRows(i) = i * 2
    Next i

    '--- How to delete them all together?

    LenStr = 0
    DelStr = ""

    For i = LBound(DelRows) To UBound(DelRows)
        LenStr = LenStr + Len(DelRows(i)) * 2 + 2

        ' One for a comma, one for the colon and the rest for the row number
        ' The goal is to create a string like
        ' DelStr = "15:15,18:18,21:21"

        If LenStr > 200 Then
            LenStr = 0
            CutHere_Str = "!"       ' Demarcator for long strings
        Else
            CutHere_Str = ""
        End If

        DelRows(i) = DelRows(i) & ":" & DelRows(i) & CutHere_Str
    Next i

    DelStr = Join(DelRows, ",")

    Dim DelStr_Cut() As String
    DelStr_Cut = Split(DelStr, "!,")
    ' Each DelStr_Cut(#) string has a usable string

    Dim DeleteRng As Range
    Set DeleteRng = ActiveSheet.Range(DelStr_Cut(0))

    For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut)
        Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i)))
    Next i

    DeleteRng.Delete

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Code zum generieren der Formeln in ein leeres Blatt ist

Sub FillRandom()
    ActiveSheet.Range("D1").FormulaR1C1 = "=SIN(RAND())"
    Range("D1").AutoFill Destination:=Range("D1:D100000"), Type:=xlFillDefault
End Sub

Und den code zur Generierung der benchmark-Ergebnisse oben ist

Sub TestTimeForDeletion()

        Call FillRandom

        Dim Time1 As Single, Time2 As Single
        Time1 = Timer

        Call DeleteRows

        Time2 = Timer
        MsgBox (Time2 - Time1)
End Sub

Hinweis: Vielen Dank brettdj für den Hinweis auf den Fehler wird ausgelöst, wenn die Länge der DelStr mehr als 255 Zeichen. Es scheint ein bekannt problem und wie ich schmerzlich herausgefunden, dass es noch existiert für Excel 2013.

InformationsquelleAutor hnk

In diesem Fall eine einfache funktionierende Formel kann verwendet werden, um zu sehen, ob jeder der Werte, die in Ihrem Bereich geprüft werden (Spalte A der Zeitplan) gibt es in Spalte F der misc

In B4 es würde =MATCH(A4,misc!D:D,0)

Dies kann verwendet werden, manuell oder mit code für ein effizientes löschen Sie die Formel, indem design gibt einen Fehler zurück, wenn keine übereinstimmung vorhanden ist, das können wir effizient löschen mit VBA mit entweder:

• AutoFilter
• SpecialCells (design Stück*)

In xl2007 beachten Sie, dass es ein limit von 8192 diskrete Bereiche, die ausgewählt werden können mit SpecialCells

code

Sub ReCut()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range

Set ws1 = Sheets("misc")
Set ws2 = Sheets("schedule")

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

Set rng1 = ws2.Range(ws2.[a4], ws2.Cells(Rows.Count, "A").End(xlUp))
ws2.Columns(2).Insert
With rng1.Offset(0, 1)
     .FormulaR1C1 = "=MATCH(RC[-1],'" & ws1.Name & "'!C[2],0)"
     On Error Resume Next
    .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
     On Error GoTo 0
End With

ws2.Columns(2).Delete

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub

InformationsquelleAutor brettdj