Leere Zeile nach gleicher Nummernfolge

[kosmoritz]

Hallo zusammen,

ich versuche gerade ein Excel Makro zu schreiben, welches eine leere Zeile nach einer immer wiederkehrenden Nummernfolge einfügt.
Nachdem die Zeile eingefügt wurde, soll der Algorhitmus weiter suchen und den nächsten Block Zahlen durch eine leere Zeile kennzeichnen.
Zum besseren Verständniss, hier der Zelltext:

WK40-4035- PC -  - BRO -  DT
WK40-4035- PC -  - BRO -  DT
WK40-4035- PC -  - BRO -  DT
WK40-4035- PC -  - BRO -  DT
WK40-4035- PC -  - BRO -  DT
WK40-4035- PC -  - BRO -  DT
WK40-6032- NB -  - GOL
WK42-4017- PC -  - SIL -  DT
WK42-4017- PC -  - SIL -  DT
WK42-4017- PC -  - SIL -  DT
WK42-4017- PC -  - SIL -  DT
WK42-4017- PC -  - SIL -  DT
WK42-4017- PC -  - SIL -  DT

Es soll von der 4 stelligen Zahl hinter WKxx ausgegangen werden. In diesem Beispiel würde das Makro also nach der 6ten Zeile, der 7ten Zeile und der 13ten Zeile eine leere Zeile einfügen.
Nach meiner Einschätzung komme ich nicht drum herum die Zellen auf die 4stellige Zahl zu dezimieren, das sollte aber kein Problem darstellen, eher der folgende Teil stellt mich vor Probleme.
Habe ein bisschen Erfahrung in java Programmierung, weshalb ich zuerst an eine while Schleife gedacht habe, wie ich diese jedoch in excel umsetze ist mir ein Rätsel.

Habe kein derart vergleichbares Problem im Forum gefunden, falls es so etwas doch schon gab bitte ich um Entschuldigung.

Danke schonmal

Viele Grüße

Moritz

[BoskoBiati]

Hallo,

ungetestet:

Code:

Sub Test()

Dim loLetzte As Long
Dim loA As Long
loLetzte = Cells(Rows.Count, 1).End(xlUp).Row
  For loA = loLetzte - 1 To 2 Step -1
      If Mid(Cells(loA, 1), 6, 4) <> Mid(Cells(loA - 1, 1), 6, 4) Then Rows(loA).EntireRow.Insert shift:=xlDown
  Next
End Sub

[kosmoritz]

Funktioniert perfekt! Danke !

:19: :19: :19:

[kosmoritz]

Habe gerade noch versucht, blauäugig wie ich bin, die erzeugte Zeile mit -> Cell.Interior.ColorIndex = 15 einzufärben, indem ich den Code Schnipsel unter die if packe.
Funktioniert natürlich nicht :/ .

[BoskoBiati]

Hallo,

Code:

Sub Test()

Dim loLetzte As Long
Dim loA As Long
loLetzte = Cells(Rows.Count, 1).End(xlUp).Row
  For loA = loLetzte - 1 To 2 Step -1
      If Mid(Cells(loA, 1), 6, 4) <> Mid(Cells(loA - 1, 1), 6, 4) Then
        Rows(loA).EntireRow.Insert shift:=xlDown
        Range(Cells(loA, 1), Cells(loA, 10)).Interior.ColorIndex = 5
      End If
  Next
End Sub

[kosmoritz]

Und nochmal danke !

VG
Moritz