Array sortieren spezial

Bernt · 2005-03-16T12:00:34+00:00

Hallo, eine Kundenliste sollen die Namen in ein Array gelesen und sortiert werden. Dann sollen alle entfernt werden, die nur einmal vorkommen, sodass nur noch die doppelt oder mehrfach vorkommenden im Array bleiben. Dieses Array dient dann dazu, eine Listbox in einer Userform zu füllen. An der mappe selbst darf nichts verändert werden, deshlab Array. Vielen dank für Hilfe Bernt

Hallo Bernt,
hast Du Dir für Dein Level nicht einwenig viel vorgenommen.
folgender Code liest Werte aus der Tabelle aus und schreibt nur einzel in die Listbox


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

Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.

Hi Bert,


Sub test2()
Dim Doppelt()
Dim c As Object
Dim i As Integer, j As Integer
Dim Text As Variant
ReDim Doppelt(2, 1)
i = 1
j = 0
Do
i = i + 1
If Cells(1 + i, 2).Value <> "" Then
Set c = Range("B:B").Find(what:=Cells(1 + i, 2).Value, after:=Cells(1 + i, 2))
If c.Row <> 1 + i Then
'            For d = 1 To j
'                If Doppelt(2, d) = Cells(1 + i, 2).Value Then
'                    Exit For
'                End If
'            Next d
'            If d > j Then
j = j + 1
ReDim Preserve Doppelt(2, j)
Doppelt(1, j) = Cells(1 + i, 1).Value
Doppelt(2, j) = Cells(1 + i, 2).Value
'            End If
End If
End If
Loop Until Cells(1 + i, 2).Value = ""
If i > 1 Then
For i = 2 To j
If StrComp(Doppelt(2, i), Doppelt(2, i - 1), vbTextCompare) < 0 Then
Text = Doppelt(2, i)
Doppelt(2, i) = Doppelt(2, i - 1)
Doppelt(2, i - 1) = Text
Text = Doppelt(1, i)
Doppelt(1, i) = Doppelt(1, i - 1)
Doppelt(1, i - 1) = Text
i = 1
End If
Next i
End If
Text = ""
'Ab hier dann Ausgabe in Userform
For i = 1 To j
Text = Text & Chr(10) & Doppelt(2, i) & " (" & Doppelt(1, i) & ")"
Next i
MsgBox Text
Der Teil mit den Hochkommas in der Mitte ist somit überflüssig, da wird geprüft, ob der Name schon mal im Array vorkommt und nur aufgenommen wenn nicht. Ohne diesen Teil kommen alle doppelten Namen so oft vor, wie sie auch drinnen sind.
Gruss
Chris
End Sub

Forumthread: Array sortieren spezial

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Array sortieren spezial

Forumthread: Array sortieren spezial

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread