Hallo!

Ich hoffe es kann mit jemand bei folgendem Problem weiterhelfen:

Ich habe eine Liste:

Ab1
Ab3
Ab5
Ab3
Bb2
Bb1
Ab3

Diese soll eventuell mit Hilfe eines Makros in folgende Form gebracht werden:

Ab1
---
Ab3
Ab3
Ab3
---
Ab5
---
Bb1
---
Bb2

Das heißt: Sortieren, aber auch nach jeder neuen Bezeichnung (neuem Zelleninhalt) soll eine Trennzeile mit z.B. "---" eingefügt werden.

Ich brauche das, da ich eine sehr lange Liste habe, über die ich auf einem anderen Arbeitsblatt mittels Datenüberprüfung ein Drop Down zur Werteauswahl erstellt habe. Um sich im Drop Down leichter orientieren zu können, wären solche Trennlinien sehr hilfreich.

DANKE!

Hallo piston

Hier, quick & dirty:

Als erstes musst du die Spalte sortieren, egal ob von A-Z oder von Z-A, hauptsache gleiche Werte liegen untereinander. Dann folgendes Makro starten, wobei du den Startpunkt (Erste Zelle der Liste) bei den zwei Konstanten angibst. 1,1 für A1

Code:

---

Sub test()
    Const spalte As Integer = 1 '(Enspricht A)
    Const starzeile As Integer = 1 '(Enspricht 1)
   
    LCiR = Cells(Rows.Count, spalte).End(xlUp).Row
   
    For i = starzeile + 1 To LCiR
        If Cells(i, spalte) <> Cells(i - 1, spalte) Then
            Cells(i, spalte).Insert Shift:=xlDown
            Cells(i, spalte).Value = "---"
            i = i + 1
        End If
    Next
End Sub

---

Hallo!

Danke erstmal!

Das Makro hat nur den Hacken, das solange Ab1, Ab3, usw. in den Zellen steht funktioniert es, aber leider nicht mehr ab Bb1,...

Schönen Gruß

Hallo piston,

das passiert bei schnellen, dreckigen Makros schon mal - in dem Fall liegt es daran, dass durch das Einfügen der Zeilen mit dem Strich die Anzahl der Zeilen nicht mehr bis zum Ende hin stimmt. In diesem Fall ist es besser von hinten nach vorne die Zeilen zu durchlaufen. Hier das angepasste Makro von skyzem:

Code:

---

Sub test()
    Const spalte As Integer = 1 '(Enspricht A)
    Const starzeile As Integer = 1 '(Enspricht 1)
   
    LCiR = Cells(Rows.Count, spalte).End(xlUp).Row
   
    For i = LCiR To starzeile + 1 Step -1
        If Cells(i, spalte) <> Cells(i - 1, spalte) Then
            Cells(i, spalte).Insert Shift:=xlDown
            Cells(i, spalte).Value = "---"
        End If
    Next
End Sub

---

Danke Stefan  

Der Code war ja wirklich richtig dreckig  
Sogar die ts habe ich in Entspricht versudelt...

DANKE - PERFEKT!