Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1256to1260
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dringend Hilfe beim Sortieren benötigt

Dringend Hilfe beim Sortieren benötigt
Jenny
Hi Ihr,
habe ein großes und dringendes Problem und hoffe, Ihr könnt mir weiterhelfen: :-)
Situation:
Ich habe eine Tabelle ("Database" = Blatt 1), die in Spalte M ausschließlich Text enthält.
Der Text besteht dabei aus einzelnen Wörtern oder Halbsätzen, die als Suchbegriffe dienen und innerhalb der Zellen jeweils durch ein Komma getrennt sind.
Die jeweiligen Suchbegriffe können dabei aus unterschiedlich vielen Worten bestehen, wobei Kommas ausschließlich zur Abgrenzung der verschiedenen Suchbegriffe verwendet werden.
Beispiel:
Zelle M10 könnte also folgendes enthalten: Maus, Katze, Hund groß, Hund sehr klein, Hund klein
Problem:
Da einige dieser Zellen mittlerweile relativ viele Suchbegriffe enthalten werden diese zunehmend unübersichtlicher und manuelles Sortieren würde vermutlich Jahrzehnte dauern. ;-)
Frage:
Gibt es eine Möglichkeit per VBA alle Begriffe in Spalte M alphabetisch zu sortieren - und das nur innerhalb der Zellen mit dem Komma als Trennzeichen ?
Das obige Beispiel in Zelle M10 sollte danach so aussehen: Hund groß, Hund klein, Hund sehr klein, Katze, Maus
Ich hoffe, Ihr könnt mir helfen ! :-)
LG und vielen Dank Euch im Voraus,
Jenny

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Dringend Hilfe beim Sortieren benötigt
28.03.2012 12:37:12
Rudi
Hallo,
teste mal:
Sub Jenny()
Dim rngC As Range, arrTmp, x
For Each rngC In Columns(13).SpecialCells(xlCellTypeConstants)
arrTmp = Split(rngC, ",")
For x = 0 To UBound(arrTmp)
arrTmp(x) = Trim(arrTmp(x))
Next
QuickSort arrTmp
rngC = Join(arrTmp, ", ")
Next
End Sub
Sub QuickSort(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile)
On Error Resume Next
Dim UnterGrenze As Long, OberGrenze As Long
Dim AktuellerWert, GemerkterWert As Variant
If IsMissing(ErsteZeile) Then
ErsteZeile = LBound(DasArray, 1)
End If
If IsMissing(LetzteZeile) Then
LetzteZeile = UBound(DasArray, 1)
End If
UnterGrenze = ErsteZeile
OberGrenze = LetzteZeile
AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2)
Do While (UnterGrenze  AktuellerWert And OberGrenze > ErsteZeile)
OberGrenze = OberGrenze - 1
Loop
If (UnterGrenze  ErsteZeile) Then Call QuickSort(DasArray, ErsteZeile, OberGrenze)
If (UnterGrenze 

Gruß
Rudi
Anzeige
AW: Dringend Hilfe beim Sortieren benötigt
28.03.2012 13:11:30
Jenny
Hallo Rudi,
ganz ehrlich: das ist der Hammer !! :-)
Es funktioniert nicht nur genial, sondern läuft auch noch richtig schnell - wahnsinn ! :-)
Ich habe nur eine Frage dazu:
Momentan sortiert es Groß- und Kleinbuchstaben separat, d.h. es kommen erst alle Begriffe nach Alphabet, die mit einem Großbuchstaben beginnen und danach separat alle Begriffe nach Alphabet, die mit einem Kleinbuchstaben beginnen.
Gibt es auch die Möglichkeit, dass hier Groß-und Kleinbuchstaben gleich behandelt werden ?
LG und ein riesen Dankeschön dafür !
Jenny
Groß-/ klein
28.03.2012 14:04:53
Rudi
Hallo,
du willst aber schon die Schreibweise beibehalten, oder?
Gruß
Rudi
Anzeige
AW: Dringend Hilfe beim Sortieren benötigt
28.03.2012 14:17:02
Rudi
Hallo,
andere Sortierroutine:

Sub QuickSort(ByRef DasArray, Optional ErsteZeile, Optional LetzteZeile)
On Error Resume Next
Dim UnterGrenze As Long, OberGrenze As Long
Dim AktuellerWert, GemerkterWert As Variant, tmpWert As Variant
Dim tmpArray, i
tmpArray = DasArray
For i = LBound(DasArray) To UBound(DasArray)
DasArray(i) = UCase(DasArray(i))
Next
If IsMissing(ErsteZeile) Then
ErsteZeile = LBound(DasArray, 1)
End If
If IsMissing(LetzteZeile) Then
LetzteZeile = UBound(DasArray, 1)
End If
UnterGrenze = ErsteZeile
OberGrenze = LetzteZeile
AktuellerWert = DasArray((ErsteZeile + LetzteZeile) / 2)
Do While (UnterGrenze  AktuellerWert And OberGrenze > ErsteZeile)
OberGrenze = OberGrenze - 1
Loop
If (UnterGrenze  ErsteZeile) Then Call QuickSort(DasArray, ErsteZeile, OberGrenze)
If (UnterGrenze 

Gruß
Rudi
Anzeige
noch was
28.03.2012 14:39:37
Rudi
Hallo,
fällt mir gerade auf:
Application.Screenupdating=False am Anfang von Jenny() beschleunigt das ganze enorm.
Hab ich vergessen.
Gruß
Rudi
AW: noch was
28.03.2012 16:05:04
Jenny
Hallo Rudi,
das ist spitze - klappt bestens !! :-)
Super klasse - vielen vielen Dank dafür ! :-)
LG und Dir noch einen schönen Nachmittag,
Jenny

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige