Leerzeilentransformation superschnell

[atilla]

Hallo Christa,

Ralf hat Dir eigentlich die schnellste Methode gezeigt, wenn es um eine große Anzahl von Zeilen geht.

Darauf wollte ich eigentlich auch hinaus, deswegen meine Frage, ob Du Formeln in Deiner Tabelle hast,
die beim Einfügen und wieder Löschen einer Hilfsspalte nicht mehr funktionieren würden.

Hier mal Ralfs Vorschlag etwas verallgemeinert und zusammengefasst mit einer temporären Hilfsspalte, die in Spalte 1 einfügt und wieder gelöscht wird:

Code:

Option Explicit

Sub Leerzeilen()
Dim lngLetzte As Long

lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
Columns(1).Insert
With Range(Cells(1, 1), Cells(lngLetzte, 1))
    .Formula = "=row()"
    .Formula = .Value
    Range(Cells(lngLetzte + 1, 1), Cells(lngLetzte * 2, 1)) = .Value
End With
Cells(1, 1).CurrentRegion.Sort , key1:=Cells(2, 1), order1:=xlAscending, Header:=xlNo
Columns(1).Delete

End Sub

Es wird davon ausgegangen, dass Deine Daten in einem zusammenhängenden Bereich liegen.

[Kuwer]

Hallo Christa,

da Du auch nach Matrixvarianten fragtest, hier meine Versionen.
Die Geschwindigkeit ist hier stark abhängig von Zeilen- und Spaltenanzahl des Bereiches.

Code:

Sub LeerzeilenEinfuegen_Kuwer()
  Dim i As Long, j As Long, k As Long
  Dim lngStartTime As Long, lngStopTime As Long
  Dim lngSpalten As Long, lngZeilen As Long
  Dim varQ As Variant, varZ As Variant
  lngStartTime = GetTickCount
  varQ = Cells(1, 1).CurrentRegion.Value
  lngZeilen = UBound(varQ, 1)
  lngSpalten = UBound(varQ, 2)
  ReDim varZ(1 To lngZeilen * 2, 1 To lngSpalten)
  For i = 1 To lngZeilen
    k = i * 2 - 1
    For j = 1 To lngSpalten
      varZ(k, j) = varQ(i, j)
    Next j
  Next i
  Cells(1, 1).Resize(lngZeilen * 2, lngSpalten).Value = varZ
  lngStopTime = GetTickCount
  MsgBox "Laufzeit " & (lngStopTime - lngStartTime) / 1000 & " Sekunden.", vbInformation
End Sub

Sub LeerzeilenLoeschen_Kuwer()
  Dim i As Long, j As Long, k As Long
  Dim lngStartTime As Long, lngStopTime As Long
  Dim lngSpalten As Long, lngZeilen As Long
  Dim varQ As Variant, varZ As Variant
  lngStartTime = GetTickCount
  varQ = Cells(2, 1).CurrentRegion.Resize(Cells(Rows.Count, 1).Row).Value
  lngZeilen = UBound(varQ, 1)
  lngSpalten = UBound(varQ, 2)
  ReDim varZ(1 To lngZeilen, 1 To lngSpalten)
  For i = 1 To lngZeilen
    If Len(varQ(i, 1)) Then
      k = k + 1
      For j = 1 To lngSpalten
        varZ(k, j) = varQ(i, j)
      Next j
    End If
  Next i
  Cells(1, 1).Resize(lngZeilen, lngSpalten).Value = varZ
  lngStopTime = GetTickCount
  MsgBox "Laufzeit " & (lngStopTime - lngStartTime) / 1000 & " Sekunden.", vbInformation
End Sub

Ich habe mal eine Tabelle zum Spielen (auch mit anderen Varianten) erstellt.

[ChristaRohn]

Hallo Leute,

Ihr seid ja wirklich alle super!!! - Natürlich je mehr Optionen abgedeckt werden, umso besser. Ob mit
Formeln oder ohne, jeder Code hat seine Vor- und Nachteile. Vor allem bringt er ganz neue Aspekte
mit sich zum lernen. Ein solches Forum lebt einfach von solchen Experten wie euch!

Ich persönlich muss mich erstmal nächste Woche mit euren VBA - Varianten auseinandersetzen
Es gibt für mich einiges zu lernen.

Danke

[Kuwer]

Hallo Atilla,

mit Deiner Sort-Variante kann ich mich auch anfreunden.

Noch etwas getrimmt ist sie auch bei nur einer Spalte schon doppelt so schnell wie meine. :22: :19:

Code:

Sub LeerzeilenEinfuegen_Atilla()
  Dim lngLetzte As Long
  Dim lngStartTime As Long, lngStopTime As Long
  Dim lngCalc As Long
'  lngStartTime = GetTickCount
  With Application
    .ScreenUpdating = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
  Columns(1).Insert
  With Range(Cells(1, 1), Cells(lngLetzte, 1))
    .Formula = "=row()"
    .Formula = .Value
    Range(Cells(lngLetzte + 1, 1), Cells(lngLetzte * 2, 1)) = .Value
  End With
  Cells(1, 1).CurrentRegion.Sort , key1:=Cells(2, 1), order1:=xlAscending, Header:=xlNo
  Columns(1).Delete
  With Application
    .Calculation = lngCalc
    .ScreenUpdating = True
  End With
'  lngStopTime = GetTickCount
'  MsgBox "Laufzeit " & (lngStopTime - lngStartTime) / 1000 & " Sekunden.", vbInformation
End Sub

Gruß Uwe