Array sortieren spezial

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm ListBox MsgBox
Bild

Betrifft: Array sortieren spezial von: Bernt
Geschrieben am: 16.03.2005 12:00:34

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

Bild


Betrifft: AW: Array sortieren spezial von: Chris
Geschrieben am: 16.03.2005 12:07:38

Hi Bernt,

ich habe das immer mit einer Schleife gemacht und dann mit *strcomp()*, damit kannst du Zeichenkettenvergleichen, wenn die Reihenfolge falsch war, habe ich die Werte nacheinander in einer Variablen gespeichert und dann ausgetauscht.

- Sobald du mehrere Sortierkriterien oder halt sehr viele Werte hast, kann´s aber ne Weile dauern

Chris


Bild


Betrifft: AW: Array sortieren spezial von: Bernt
Geschrieben am: 16.03.2005 12:35:44

Hallo,

mit deinem Denkanstoß kann ich leider mangels VBA-Kenntnissen nichts anfangen.

Gruß Bernt


Bild


Betrifft: AW: Array sortieren spezial von: Nike
Geschrieben am: 16.03.2005 12:16:48

Hi,

wie waere es mit einem Dateiaufbau?
Sind die Namen in einer Spalte oder getrennt nach Vor/Nachname
Also, bevor man den Wert ins Array aufnimmt per Worksheetfunction.countif()
auf doppelte Werte pruefen, wenn ja, dann auf vorhandensein im Array pruefen
und dann uebernehmen...

Eine Bsp Datei mit verfremdeten Daten
waere vielleicht nicht schlecht zur Veranschaulichung.

Bye

Nike


Bild


Betrifft: AW: Array sortieren spezial von: Bernt
Geschrieben am: 16.03.2005 12:34:34

Hallo,

eine ganz einfache Namensliste. Letztlich sollen in der Listbox alle sortiert
erscheinen, die doppelt vorkommen. Listbox zweispaltig, sodass Nr. und Nachname
zu sehen sind.

https://www.herber.de/bbs/user/19732.xls

Gruß Bernt


Bild


Betrifft: AW: Array sortieren spezial von: Hajo_Zi
Geschrieben am: 16.03.2005 12:18:34

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.




Bild


Betrifft: AW: Array sortieren spezial von: Bernt
Geschrieben am: 16.03.2005 12:25:21

Hallo,

ich will nicht die Unikate, sondern nur die, die doppelt oder mehrfach vorkommen.

Gruß Bernt


Bild


Betrifft: AW: Array sortieren spezial von: Hajo_Zi
Geschrieben am: 16.03.2005 12:27:39

Hallo Bernt,

das hatte ich schon gelesen, darum auch meine Frage.

Gruß Hajo

Das Forum lebt auch von den Rückmeldungen.


Bild


Betrifft: noch offen oT von: Bernt
Geschrieben am: 16.03.2005 12:40:23

b


Bild


Betrifft: AW: noch offen oT von: Chris
Geschrieben am: 16.03.2005 12:59:21

Hilft dir das:


Sub TEST()
Dim Doppelt()
Dim c As Object
Dim i As Integer, j As Integer
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)
Next i
MsgBox Text
End Sub


Gruss

Chris


Bild


Betrifft: danke aber leider... von: Bernt
Geschrieben am: 16.03.2005 13:34:20

Hallo,

Fehler beimKompilieren, Variable nicht definiert oder ähnlich und die Zeile

For d = 1 To j wird markiert. Was tun?

Gruß Bernt


Bild


Betrifft: AW: danke aber leider... von: Chris
Geschrieben am: 16.03.2005 13:35:57

Sorry, das muss das Alter sein!!

Pack oben noch ein *Dim d as integer* rein

Gruss

Chris


Bild


Betrifft: AW: danke aber leider... von: Bernt
Geschrieben am: 16.03.2005 14:35:49

Hallo,

jetzt das selbe bei der Zeile: Text = Doppelt(2, i)

was tun?

Gruß Bernt


Bild


Betrifft: So´n Sch....!!!!! von: Chris
Geschrieben am: 16.03.2005 14:41:26

Das gleiche nochmal für die Variable *Text*

Dim Text as variant

:o) Chris


Bild


Betrifft: AW: So´n Sch....!!!!! von: Bernt
Geschrieben am: 16.03.2005 15:06:47

Hallo,

so, jetzt läuft das, aber er listet mir alle auf aber nur einmal, ich brauche aber
alle Doppler/Mehrfachen, du verstehst? Als wenn Meier 7 mal vorkommt, soll er auch
7 mal in der Liste stehen.

Gruß Bernt


Bild


Betrifft: Das doch schon mal ein Fortschritt :o) von: Chris
Geschrieben am: 16.03.2005 15:19:30

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



Bild


Betrifft: Super, so ist es perfekt, danke oT von: Bernt
Geschrieben am: 16.03.2005 16:04:56

B


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Array sortieren spezial"