Leerzeilen nach Datum einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton5_Click() '3 Leerzeilen nach jedem neuen Jahr einfügen Dim k As Long Dim lastrow As Long Dim varJahr lastrow = UsedRange.SpecialCells(xlCellTypeLastCell).Row For k = lastrow To 2 Step -1 If IsDate(Cells(k, 1).Value) = True Then If Year(Cells(k, 1)) varJahr Then Rows(k).Insert Rows(k).Insert Rows(k).Insert varJahr = Year(Cells(k, 1)) End If End If Next

Private Sub CommandButton1_Click() Dim k As Long, Jahr1 As Long, Jahr2 As Long Application.ScreenUpdating = False For k = UsedRange.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1 If IsDate(Cells(k, 1)) And IsDate(Cells(k - 1, 1)) Then Jahr1 = Year(Cells(k, 1)) Jahr2 = Year(Cells(k - 1, 1)) If Jahr1 Jahr2 Then Rows(k).Resize(3).Insert End If End If Next k End Sub

Private Sub CommandButton1_Click() '3 Leerzeilen nach jedem neuen Jahr einfügen Dim k As Long Dim lastrow As Long Dim varJahr Application.ScreenUpdating = False lastrow = UsedRange.SpecialCells(xlCellTypeLastCell).Row For k = lastrow To 2 Step -1 If IsDate(Cells(k, 1).Value) = True Then If Year(Cells(k, 1)) varJahr Then varJahr = Year(Cells(k, 1)) Range(Rows(k + 1), Rows(k + 3)).Insert End If End If Next Application.ScreenUpdating = True End Sub

Hi
Leerzeilen per Schleife einfügen ist langsam, vorallem wenns viele sind.
wesentlich schneller ist einsortieren, schau dir mal das an.

Private Sub CommandButton1_Click()
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
With Cells(1, 1).CurrentRegion
With .Columns(.Columns.Count + 1).Resize(, 2)
.Columns(1).FormulaR1C1 = "=Row()"
.Columns(2).FormulaR1C1 = "=IF(year(RC1)year(R[1]C1),Row(),"""")"
.Cells(1, 2).Value = ""
.Formula = .Value
If WorksheetFunction.Count(.Columns(2)) > 0 Then
.Columns(2).SpecialCells(xlCellTypeConstants, 1).Copy
.Cells(1, 1).End(xlDown).Offset(1, 0) _
.Resize(WorksheetFunction.CountA(.Columns(2)) * 3).PasteSpecial xlPasteValues
.CurrentRegion.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
.EntireColumn.ClearContents
End If
End With
End With
End Sub

Gruß Daniel

Hi
neben der Geschwindigkeit hat die Turbolösung noch weitere Vorteile:
Diese Methode kann man auch ohne Makro von Hand ausführen wenn es nur eine einmalig Aktion ist.
Du musst ja nur die beiden Formeln am Tabellenende eintragen und als Wert einfügen, dann die Zahlen aus der zweiten Spalte unter die erste Spalte kopieren und dann die ganze Liste nach der ersten Zusatzspalte sortieren.
man kann auch einfacher testen, ob die Zeilen an der richtigen Stelle eingefügt werden, wenn man sich die Werte der zweiten Spalte anschaut, bevor man sie kopiert. Man hat dann die Ausgangsdaten noch nicht verändert hat somit keinen Aufwand zum zurückändern, wenn man feststellt dass die Formel noch falsch ist.
ebenso ist das Testen des Makros im Einzelstep einfacher, wenn man keine Schleifen hat.
Das kommt vorallem dann zum Tragen, wenn man größere Makros erstellt, bei denen solche Aktionen nur kleine Teilschritte sind.
Wenn du dich dann beim Testen immer durch die Schleife tickern oder immer Haltepunkte setzen musst, ist das nervig.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Leerzeilen nach Datum einfügen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread