Leerzeile nach zwei gleichen Zeilen

Bild

Betrifft: Leerzeile nach zwei gleichen Zeilen
von: Rainer
Geschrieben am: 28.10.2003 19:27:34

Hallo,
ich habe folgendes Problem: Ich habe in meiner Tabelle über ein Makro jeweils doppelte Datensätze ausgeblendet. Datensätze (jeweils 2), die sich unterscheiden, sind sichtbar.
Beispiel:
Artikelnummer;Preis
4711;10 (ausgeblendet)
4711;10 (ausgeblendet)
4712;11
4712;12
4713;44
4713;45
4714;99 (ausgeblendet)
4714;99 (ausgeblendet)

Zur Übersichtlichkeit möchte ich jeweils zwischen 4712 und 4713 eine Leerzeile einfügen. Es sollen aber nur eingeblendete Zeilen berücksichtigt werden. Kann mir jemand helfen?
Danke
Rainer

Bild


Betrifft: AW: Leerzeile nach zwei gleichen Zeilen
von: Oliver
Geschrieben am: 28.10.2003 20:54:29

Hallo Rainer,

hier das benötigte Makro:

Sub leerzeile_einfügen()
    For zeile = 1 To 10
    a = Worksheets(1).Cells(zeile, 1).Value
    b = Worksheets(1).Cells(zeile + 1, 1).Value
    If a = b Then Rows(zeile + 2 & ":" & zeile + 2).Select
    Selection.Insert shift:=xlDown
    Next zeile
End Sub


Viel Spaß damit!
Gruß Oliver


Bild


Betrifft: AW: Leerzeile nach zwei gleichen Zeilen
von: Oliver
Geschrieben am: 28.10.2003 21:21:17

Hallo Rainer,
kurzer Nachtrag wegen den "nur eingeblendeten Zellen":


Sub leerzeile_einfügen()
    For zeile = 1 To 10
    a = Worksheets(1).Cells(zeile, 1).Value
    b = Worksheets(1).Cells(zeile + 1, 1).Value
    If a = b Then Rows(zeile + 2 & ":" & zeile + 2).Select
    If a <> b Then GoTo weiter
    Rows(zeile + 1 & ":" & zeile + 1).Select
    If Selection.EntireRow.Hidden = True Then GoTo weiter
    Rows(zeile + 2 & ":" & zeile + 2).Select
    Selection.Insert shift:=xlDown
weiter:
    Next zeile
End Sub



Bild


Betrifft: Quatsch!
von: xXx
Geschrieben am: 28.10.2003 21:25:12

Hallo,
damit wird 1. nicht berücksichtigt, ob eine Zeile ausgeblendet ist und 2. scheitert das Makro bzw. fügt zu viele Zeilen ein, wenn mehr als 2 aufeinander folgende Zeilen den gleichen Inhalt haben.

Sub Zeile_einfügen()
z = 1
Do
If IsEmpty(Cells(z, 1)) Then Exit Do
If Rows(z).Hidden = False Then
  If Cells(z + 1, 1) <> Cells(z, 1) Then
    Rows(z + 1).EntireRow.Insert shift:=xlDown
    z = z + 2
  End If
End If
z = z + 1
Loop
End Sub

Gruß aus'm Pott
Udo
http://www.excelerator.de

P.S.Das Forum lebt auch von den Rückmeldungen der Frager an die Antworter.


 Bild

Beiträge aus den Excel-Beispielen zum Thema " Leerzeile nach zwei gleichen Zeilen"