Hallo zusammen,
ich habe in drei Spalten C,D und G in den Zellen mehrere Einträge die durch ein Komma voneinander separiert werden.
Was ich gerne hätte wäre ein Makro das die Einträge je Zelle alphabetisch sortiert wenn man einen neuen Eintrag macht.
Aktuell sind die Einträge je Zelle alphabetisch sortiert aber es kommen regelmäßig neue Einträge hinzu.
Besten Dank vorab für eure Hilfe =)
Leo
Hallo Günther,
die Mühe hatte ich mir auch schon gemacht.
Ich will gerne ohne Hilfsspalten arbeiten weil ein anderen Makro auf die Daten zugreift, daher fallen der 1. und 3. Link von dir weg.
Der 2 Link sieht hilfreich aus (den hatte ich tatsächlich vorher nicht gegoogelt), da müsste ich mal schauen wie ich das auf mehrere Spalten anpasse und ob es dann funktioniert, das scheint zum Ende hin ja außerhalb des Threads gelöst worden zu sein.
Beste Grüße
Leo
Mit dem Code aus dem 2. Link, laufe ich in den gleichen Fehler wie der Kollege im Thread beschrieben hat.
Code:
Sub Daten_sortieren()
Dim Aktiver_Blattname As String, Wiederholungen_Zeile As Long, _
Wiederholungen_Spalte As Integer, Wiederholungen_Zeile_Tab2 As Long
Application.ScreenUpdating = False
Aktiver_Blattname = ActiveSheet.Name
With Worksheets.Add
.Name = "Hilfsblatt"
End With
For Wiederholungen_Zeile = 1 To Sheets(Aktiver_Blattname).Range("A65536").End(xlUp).Row
Sheets("Hilfsblatt").Cells.ClearContents
Sheets("Hilfsblatt").Range("A1") = Sheets(Aktiver_Blattname).Cells(Wiederholungen_Zeile, 1)
Sheets("Hilfsblatt").Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, TrailingMinusNumbers:=True
For Wiederholungen_Spalte = 2 To Sheets("Hilfsblatt").Range("IV1").End(xlToLeft).Column
Sheets("Hilfsblatt").Cells(Sheets("Hilfsblatt").Range("A65536").End(xlUp).Offset(1, 0).Row, 1) = _
Sheets("Hilfsblatt").Cells(1, Wiederholungen_Spalte)
Sheets("Hilfsblatt").Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlDescending
Sheets("Hilfsblatt").Range("B1").ClearContents
For Wiederholungen_Zeile_Tab2 = 1 To Sheets("Hilfsblatt").Range("A65536").End(xlUp).Row
Sheets("Hilfsblatt").Range("B1") = Sheets("Hilfsblatt").Cells(Wiederholungen_Zeile_Tab2, 1) _
& " " & Sheets("Hilfsblatt").Range("B1")
Sheets(Aktiver_Blattname).Cells(Wiederholungen_Zeile, 1) = Sheets("Hilfsblatt").Range("B1")
Next
Next
Next
Sheets(Aktiver_Blattname).Activate
Application.DisplayAlerts = False
Sheets("Hilfsblatt").Delete
Application.DisplayAlerts = True
End Sub
Hi
hier ein Beispiel für Doppelklick auf eine Zelle. (Werte durch komma und leer getrennt. cc, ee, aa)
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ArrL As Object, ArrA, it
Set ArrL = CreateObject("System.Collections.ArrayList")
ArrA = Split(Target.Value, ", ")
For Each it In ArrA
ArrL.Add it
Next it
ArrL.Sort
Target.Value = Join(ArrL.toarray, ", ")
End Sub
Gruß Elex