An oberster Stelle sollen quasi die Unikate aus Zeile 2 stehen danach die Paare usw.
Der Grund ist, dass ich mir die Unikate nochmal anschauen möchte bevor ich sie im lösche.
Die Datei https://www.herber.de/bbs/user/51473.xls wurde aus Datenschutzgründen gelöscht
Sub test()
Dim z1 As Long, z2 As Long
z1 = ActiveSheet.UsedRange.Row
z2 = ActiveSheet.UsedRange.Rows.Count
Range("A:B").Insert
Cells(z1, 2).Resize(z2, 1).FormulaR1C1Local = "=ZS(1)&ZS(2)"
Cells(z1, 1).Resize(z2, 1).FormulaR1C1Local = "=WENN(ZÄHLENWENN(S(1);ZS(1))>1;WAHR;ZEILE() _
)"
With Cells(z1, 1).Resize(z2, 2)
.Formula = .Value
.EntireRow.Sort key1:=Cells(z1, 1) '--- kann weggelassen werden, dann wirds bei _
grossen _
Tabellen langsamer
On Error Resume Next
.SpecialCells(xlCellTypeConstants, 4).select ' --- diese Zeile ist nur nur zur _
Verdeutlichung im Einzelstepmodus
.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
On Error GoTo 0
.EntireColumn.Delete
End With
End Sub
Aber jetzt nochmal mein jetziges Anliegen und das des Threats. Ich möchte einfach eine Spalte mit mehreren Duplikaten und Unikaten nach Häufigkeit sortieren, sodass die Zeilen nach dieser Reihenfolge sortiert werden. Ich möchte dann die Unikate überprüfen und im Anschluss löschen um noch mehr Platz im Dokument zu schaffen.
Hoffe es ist verständlich genug ausgedrückt.