Nach jeder Zeile, 3 weitere Zeilen einfügen

Hallo Leute!
Ich hab folgendes Problem...
Ich bekomme Werte von einer Messstation die mir stundenweise Messpunkte liefert.
Meine Tabelle hat mittlerweile über 15.000 Zeilen mit diesen Messwerten.
Aufgrund einer Vorgabe ist es nun aber nötig diese Werte im Viertelstundentakt anzugeben.
Das bedeutet für mich, dass ich nach jeder Zeile, 3 weitere Zeilen einfügen muss um dort statt
15:00
16:00
17:00
18:00
19:00
sowas dastehen hab:
15:00
15:15
15:30
15:45
16:00
Die Zwischenwerte kann ich dann ganz einfach berechnen und per autokopieren ausfüllen.
Es geht mir also eigentlich nur um das Einfügen der 3 Zeilen nach jeder Zeile.
Wenns mit VBA geht wäre es mir am liebsten, aber auch jeder andere Lösungsvorschlag ist super. Ob das ganze langsam ist, ist auch nebensächlich.
Ich hoffe ihr könnt mir auch diesmal wieder helfen.
Danke im Vorraus und liebe Grüsse
Martin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tt() Const ersteZeile = 3 ' erste Zeile mit Zeitangaben (z.B. 3 bei Überschrift in Zeilen 1 u. 2) Dim z As Long, i As Long Dim dat As Date z = Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False ' damit geht's schneller du siehst aber nix For i = z To ersteZeile + 1 Step -1 dat = Cells(z - 1, 1) Cells(i, 1).EntireRow.Insert Cells(i, 1).EntireRow.Insert Cells(i, 1).EntireRow.Insert Cells(i, 1) = Cells(i - 1, 1) + TimeValue("00:15") Cells(i + 1, 1) = Cells(i - 1, 1) + TimeValue("00:30") Cells(i + 2, 1) = Cells(i - 1, 1) + TimeValue("00:45") Next i Application.ScreenUpdating = True End Sub

Hi Martin,
Du gibst Excel 2003 und über 15.000 Zeilen an!
Das könnte zu Problemen führen, denn wenn du jedesmal 3 Zeilen einfügst, ergibt dies eine Maximale jetzige Zeilenanzahl von 16384!!
Trotzdem, probier's mal:


Sub VerDreifachen()
Dim lx As Long
For lx = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row To 2 Step -1
ActiveSheet.Rows(lx + 1).Insert (xlShiftDown)
ActiveSheet.Cells(lx + 1, 1).Value = ActiveSheet.Cells(lx, 1).Value + 3 * (1 / 96)
ActiveSheet.Rows(lx + 1).Insert (xlShiftDown)
ActiveSheet.Cells(lx + 1, 1).Value = ActiveSheet.Cells(lx, 1).Value + 2 * (1 / 96)
ActiveSheet.Rows(lx + 1).Insert (xlShiftDown)
ActiveSheet.Cells(lx + 1, 1).Value = ActiveSheet.Cells(lx, 1).Value + (1 / 96)
Next lx
End Sub

GreetZ Renée

Beliebteste Forumthreads (12 Monate)

Nach jeder Zeile, 3 weitere Zeilen einfügen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread