Hallo,

diese Variante läuft schneller durch:

Sub CompressData()
    Dim wsh As Worksheet
    Dim rngDelete As Range
    Dim lngRow As Long, lngRowTimer As Long, lngTimerSecond As Long
    Dim sMsg As String
    Dim datDate As Date
    Dim lngTimer As Long
    Set wsh = Tabelle1
    Application.ScreenUpdating = False
    lngRow = 2
    lngRowTimer = 2
    Do Until lngRow > wsh.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        If IsDate(wsh.Cells(lngRow, 1).Value) Then
            If datDate = 0 Then
                datDate = wsh.Cells(lngRow, 1).Value
            Else
                If DateDiff("s", datDate, wsh.Cells(lngRow, 1)) < 60 Then
                    If rngDelete Is Nothing Then
                        Set rngDelete = wsh.Cells(lngRow, 1)
                    Else
                        Set rngDelete = Union(rngDelete, wsh.Cells(lngRow, 1))
                    End If
                Else
                    datDate = wsh.Cells(lngRow, 1).Value
                End If
            End If
        End If
        If Timer - lngTimerSecond >= 1 Then
            sMsg = " (" & lngRow - lngRowTimer & "/Sek.)"
            lngTimerSecond = Timer
            lngRowTimer = lngRow
        End If
        Application.StatusBar = "Analisiere Zeile " & lngRow & " ..." & sMsg
        If (Timer - lngTimer) > 10 Then
            lngTimer = Timer
            VBA.DoEvents
        End If
        lngRow = lngRow + 1
    Loop
    If Not rngDelete Is Nothing Then
        rngDelete.EntireRow.Delete shift:=xlUp
    End If
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub

Bei dieser Variante wurden am Anfang etwa 270 Zeilen pro Sekunde gemesen. Zum Ende sank die Quote allerdings auf etwa 130 Zeilen pro Sekunde ab.

Ursache: Der Befehl Union erstellt bei jedem Durchlauf ein neues Area. Bei 50.000 Zeilen kommen viele Areas zusammen. Je mehr Areas vorhanden sind, desto mhr braucht Excel für die Verwaltung.

Mögliche Lösung: Wenn bei ei nem Union-Befehl gleich mehrere zusammenhängende Zeilen angegeben werden, fallen nur noch etwa 10% an Areas an, die von Excel verwaltet werden müssen.

LG, Ben