AW: Doppelungen in ComboBox vermeiden und danach sorti
12.12.2005 12:56:58
Hajo_Zi
Hallo Reiner,
anlog diesem Beispiel.
Option Explicit
' erstellt von Hajo.Ziplies@web.de
Private Sub UserForm_Initialize()
Dim StListe() As String
Dim Loletzte As Long
Dim LoI As Long
Loletzte = 65536
If Range("A65536") = "" Then Loletzte = Range("A65536").End(xlUp).Row
'Array Dimensionieren
ReDim Preserve StListe(1 To Loletzte)
For LoI = 2 To Loletzte
StListe(LoI - 1) = Cells(LoI, 1)
Next LoI
' Liste sortieren
Sort_A_Z StListe, LBound(StListe), UBound(StListe) ' Lbound kleinster Wert,UBound Größter Wert
' Liste in Listbox übertragen ohne Doppelte
ListBox1.AddItem StListe(1)
For LoI = 2 To Loletzte
If StListe(LoI) <> StListe(LoI - 1) Then ListBox1.AddItem StListe(LoI)
Next LoI
End Sub
Public Sub Sort_Z_A(SortArray, L, R)
' sortieren von Z bis A
' von GerdZ Herber.de
Dim I, J, x, y
I = L
J = R
x = SortArray((L + R) / 2)
While (I <= J)
While (SortArray(I) < x And I < R)
I = I + 1
Wend
While (x < SortArray(J) And J > L)
J = J - 1
Wend
If (I <= J) Then
y = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = y
I = I + 1
J = J - 1
End If
Wend
If (L < J) Then Call Sort_Z_A(SortArray, L, J)
If (I < R) Then Call Sort_Z_A(SortArray, I, R)
End Sub
Public Sub Sort_A_Z(SortArray, L, R)
' sortieren von A bis Z
' von GerdZ Herber.de
Dim I, J, x, y
I = L
J = R
x = SortArray((L + R) / 2)
While (I <= J)
While (SortArray(I) > x And I < R)
I = I + 1
Wend
While (x > SortArray(J) And J > L)
J = J - 1
Wend
If (I <= J) Then
y = SortArray(I)
SortArray(I) = SortArray(J)
SortArray(J) = y
I = I + 1
J = J - 1
End If
Wend
If (L < J) Then Call Sort_A_Z(SortArray, L, J)
If (I < R) Then Call Sort_A_Z(SortArray, I, R)
End Sub