Sub ZeilenEinfuegen()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(i, "A") <> Cells(i + 1, "A") Then
Cells(i, "A").EntireRow.Insert
Cells(i, "A") = Cells(i + 1, "A")
End If
Next
End Sub
Gruß Jürgen
AW: Zeilen einfügen
Hermann
Hallo Jürgen,
funktioniert schon ganz gut.
Es wird aber nicht die ganze Zeile kopiert und eingefügt, sondern nur eine Zelle eingefügt.
Gruß
Hermann
Etwas Schwund ist überall! :)
Backowe
Hi Hermann,
ist mir irgendwie durch die Lappen gegangen! ;o)
| VBA-Code: | Sub ZeilenEinfuegen()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If i < Cells(Rows.Count, "A").End(xlUp).Row And _
Cells(i, "A") <> Cells(i + 1, "A") Then
Cells(i + 1, "A").EntireRow.Insert
Rows(i + 2).Copy Destination:=Rows(i + 1)
End If
Next
End Sub
Gruß Jürgen
Eine bessere Alternative wäre ...
Backowe
Hallo Hermann,
... folgender Code:
| VBA-Code: | Sub ZeilenVonObenNachUntenEinfuegen()
Dim i As Long, y As Long
y = 1
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i + y, "A") <> Cells(i, "A") Then
Rows(i + y).EntireRow.Insert
Rows(i + y - 1).Copy Destination:=Rows(i + y)
y = y + 1
End If
Next
End Sub
Gruß Jürgen
AW: Eine bessere Alternative wäre ...
Hermann
Hi Jürgen,
schon besser, aber es wird bei jedem Wechsel kopiert. Vielleicht habe ich mich zu Beginn shlecht ausgedrückt.
Es sollen nur immer die letzte Zeile kopiert werden, wenn ein Wechsel stattfindet.
Also wie folgt:
A
A - kopieren
B
B
B -kopieren
C - kopieren
D
D - kopieren
E
..
Gruß Hermann
Mit Kanonen auf Spatzen! ;o)
Backowe
Hi Hermann,
| VBA-Code: | Sub ZeilenVonObenNachUntenEinfuegenMitArray()
Dim i As Long, y As Long
Dim ZZaehler() As Integer
Dim intCounter As Integer
y = 1
intCounter = 1
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row - 1
ReDim Preserve ZZaehler(intCounter)
If Cells(i + 1, "A") <> Cells(i, "A") Then
ZZaehler(intCounter) = i + y
intCounter = intCounter + 1
y = y + 1
End If
Next
For intCounter = 1 To UBound(ZZaehler)
Rows(ZZaehler(intCounter)).EntireRow.Insert
Rows(ZZaehler(intCounter) - 1).Copy Destination:=Rows(ZZaehler(intCounter))
Next intCounter
End Sub
Gruß Jürgen
Variablendeklaration vergessen! :(
Backowe
Hi Hermann,
| VBA-Code: | Option Explicit
Option Base 1
Sub ZeilenVonObenNachUntenEinfuegenMitArray()
Dim i As Long, y As Long
Dim ZZaehler() As Integer
Dim intCounter As Integer
y = 1
intCounter = 1
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row - 1
ReDim Preserve ZZaehler(intCounter)
If Cells(i + 1, "A") <> Cells(i, "A") Then
ZZaehler(intCounter) = i + y
intCounter = intCounter + 1
y = y + 1
End If
Next
For intCounter = 1 To UBound(ZZaehler)
Rows(ZZaehler(intCounter)).EntireRow.Insert
Rows(ZZaehler(intCounter) - 1).Copy Destination:=Rows(ZZaehler(intCounter))
Next intCounter
End Sub
Gruß Jürgen
AW: Spatz ist erledigt :o)
Hermann
Hi Jürgen,
vielen Dank für Deine Hilfe!!
Gruß
Hermann
|
|
|
|
|