Bubblesort Array mit Spaltenauswahl
14.07.2016 14:53:07
Michael
Hi Alex,
am einfachsten ist es, Du steckst den kompletten Inhalt der Listbox in ein standardmäßig verstecktes Tabellenblatt und nimmst die range.sort; das klingt erst mal umständlich, hat aber den Vorteil, daß Du dann ohne großes Zutun auch nach mehreren Kriterien gleichzeitig sortieren kannst (z.B. Nachname & Vorname).
Nachfolgend eine Lösung, die alle Spalten eines Arrays sortiert: HIER wird ein Array aus einem Tabellenbereich verwendet, das beginnt immer ab 1, während ein Array, das Du aus LIB1.List zuweist, mit 0 beginnt: das ist bei den Spaltennummern zu beachten.
Der Algo ist insoweit optimiert, als ein Array erzeugt wird, das die "originalen" Zeilennummern enthält sowie die Begriffe aus der zu sortierenden Spalte.
Beides wird sortiert, und anschließend erst werden die kompletten Werte des Gesamt-Arrays anhand der soeben mitsortierten Zeilennummern zugewiesen.
Makro:
Option Explicit
Public a, ULv, ULn
Const ULvon = "ß,Ä,Ö,Ü", ULnach = "ss,AE,OE,UE"
Sub BS_Aufrufen()
a = Range("B2").CurrentRegion
ULv = Split(ULvon, ",")
ULn = Split(ULnach, ",")
Bubblesort (Range("E4"))
Range("H2").Resize(UBound(a), UBound(a, 2)) = a
End Sub
Function UL(s$) As String
Dim i&
For i = 0 To 3
s = Replace(s, ULv(i), ULn(i))
Next
UL = s
End Function
Sub Bubblesort(sp&) ' sp = Spaltennr.
Dim s, b, stemp0, stemp1
Dim i&, k&, iA&, iB&
ReDim s(LBound(a) To UBound(a), 1)
For i = LBound(a) To UBound(a)
s(i, 0) = i
s(i, 1) = UL(UCase(a(i, sp))) ' einmal reicht...
Next
Range("E10").Resize(UBound(s), 2) = s
MsgBox "Das ist das Array s vor dem Sortieren"
For iA = LBound(a) To UBound(a)
For iB = LBound(a) To iA - 1
If s(iB, 1) > s(iA, 1) Then
stemp0 = s(iB, 0): stemp1 = s(iB, 1)
s(iB, 1) = s(iA, 1): s(iB, 0) = s(iA, 0)
s(iA, 0) = stemp0: s(iA, 1) = stemp1
End If
Next iB
Next iA
Range("G10").Resize(UBound(s), 2) = s
MsgBox "Das ist das Array s nach dem Sortieren"
b = a
For i = LBound(a) To UBound(a)
For k = LBound(a, 2) To UBound(a, 2)
a(i, k) = b(s(i, 0), k)
Next
Next
MsgBox "Jetzt wurde a anhand der Nr. in s aufgefüllt."
End Sub
Die Function UL sortiert die Umlaute richtig ein, sonst kommt Mz vor Mü...
Mit Spieldatei: https://www.herber.de/bbs/user/107013.xlsm
Schöne Grüße,
Michael