Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sortieren

Forumthread: Sortieren

Sortieren
31.08.2008 14:04:18
Fabian
ich hab da ma ein Program zur Sortierung von Zahlen geschrieben!
Sub zahlen_sortieren() Dim k(1 To 4) As Integer Dim z(1 To 4) As Integer Dim zaehler As Integer For zaehler = LBound(z) To UBound(z) z(zaehler) = InputBox("Geben Sie bitte eine Zahl ein") Next zaehler zaehler = 0 k(1) = z(1) For zaehler = 2 To 4 If k(1) > z(zaehler) Then k(1) = z(zaehler) End If Next zaehler zaehler = 0 k(2) = z(2) For zaehler = 1 To 4 If k(2) = k(1) Then k(2) = z(zaehler) End If Next zaehler zaehler = 0 For zaehler = 2 To 4 If k(2) > k(1) And k(1) z(zaehler) And k(2) > z(zaehler) Then k(2) = z(zaehler) End If Next zaehler zaehler = 0 k(3) = z(3) For zaehler = 1 To 4 If k(1) = k(3) Or k(2) = k(3) Then If z(zaehler) k(1) And z(zaehler) k(2) Then k(3) = z(zaehler) End If End If Next zaehler zaehler = 0 For zaehler = 2 To 4 If k(3) > k(1) And k(3) > k(2) And k(1) z(zaehler) And k(2) z(zaehler) And k(3) > z( _ zaehler) Then k(3) = z(zaehler) End If Next zaehler zaehler = 0 For zaehler = 1 To 4 If z(zaehler) k(1) And z(zaehler) k(2) And z(zaehler) k(3) Then k(4) = z(zaehler) End If Next zaehler MsgBox k(1) & "," & k(2) & "," & k(3) & "," & k(4) End Sub


hab dieses versucht mit einer schleife zu verkürzen, was aber nicht funktioniert, bitte helft mir!


Sub zahlen_sortieren()
Dim k(1 To 4) As Integer
Dim z(1 To 4) As Integer
Dim i As Integer
Dim zaehler As Integer
For zaehler = LBound(z) To UBound(z)
z(zaehler) = InputBox("Geben Sie bitte eine Zahl ein")
Next zaehler
i = 0
zaehler = 0
While i 


Danke für eure Hilfe!

Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Quicksort
31.08.2008 14:38:00
{Boris}
Hi Fabian,
dafür gibt es Sortieralgorithmen wie z.B. Quicksort. Der Clou liegt im rekursiven Aufruf der Funktion sowie in der Aufteilung der zu sortierenden Daten in 2 Hälften (links und rechts). Dadurch werden die inneren Schleifen sehr kurz und das Ganze mordmäßig schnell:

Option Explicit
Sub test()
Dim z(1 To 4) As Integer
Dim zaehler As Integer
Dim strMessage As String
For zaehler = LBound(z) To UBound(z)
z(zaehler) = InputBox("Geben Sie bitte eine Zahl ein")
Next zaehler
Quicksort z(), 1, 4
For zaehler = 1 To 4
strMessage = strMessage & z(zaehler) & vbLf
Next zaehler
MsgBox strMessage
End Sub
Private Function Quicksort(Data, links, rechts)
Dim Teiler As Long
If rechts > links Then
Teiler = Teile(Data, links, rechts)
Call Quicksort(Data, links, Teiler - 1)
Call Quicksort(Data, Teiler + 1, rechts)
End If
End Function
Private Function Teile(Data, links, rechts)
Dim Index As Long
Dim i As Long
Index = links
For i = links To rechts - 1
If Data(i) 


Grüße Boris

Anzeige
Alternativ: Sortieren mit dem ListView-Steuerelem.
31.08.2008 14:56:59
{Boris}
Hi Fabian,
...eine sehr einfache und ebenfalls sauschnelle Möglichkeit bietet das ListView-Steuerelement. Es hat die sehr nützliche Sorted-Eigenschaft, die man einfach auf TRUE stellen kann - und schon ist alles sortiert.
Füge ein Userform ein und platziere darauf ein ListView-Steuerelement (zu finden unter "Zusätzliche Steuerelemente, Microsoft ListView-Control ...). Das Userform selbst wird gar nicht benötigt, aber dadurch stehen einem die bereits beschriebenen Eigenschaften des ListView zur Verfügung.
Der Testcode lautet nun (in einem allgemeinen Modul):

Option Explicit
Sub test()
Dim x As Long
Dim strTemp As String
With UserForm1.ListView1
.ListItems.Clear
For x = 1 To 4
.ListItems.Add(x) = InputBox("Zahl")
Next x
.Sorted = True
For x = 1 To 4
strTemp = strTemp & .ListItems(x) & vbLf
Next x
End With
MsgBox strTemp
End Sub


Grüße Boris

Anzeige
AW: Alternativ: ArrayList
31.08.2008 15:23:22
ransi
HAllo
Hier noch etwas "exotisches":
Option Explicit


Public Sub Array_list()
Dim AL As Object
Dim Arr(3)
Dim L As Long
Set AL = CreateObject("System.collections.Arraylist")
Dim I As Integer
For I = 0 To 3
    L = Application.InputBox(prompt:="Zahl eingeben", Type:=1)
    AL.Add L
Next
SL.Sort
For I = 0 To 3
    Arr(I) = AL.Item(I)
Next
MsgBox Join(Arr, vbCrLf)
End Sub

ransi
Anzeige
Dreckfuhler
31.08.2008 15:26:32
ransi
Hallo
So ists richtig...
Option Explicit


Public Sub Array_list()
Dim AL As Object
Dim Arr(3)
Dim L As Long
Set AL = CreateObject("System.collections.Arraylist")
Dim I As Integer
For I = 0 To 3
    L = Application.InputBox(prompt:="Zahl eingeben", Type:=1)
    AL.Add L
Next
AL.Sort
For I = 0 To 3
    Arr(I) = AL.Item(I)
Next
MsgBox Join(Arr, vbCrLf)
End Sub

ransi
Anzeige
Tempomessung...
31.08.2008 15:39:00
{Boris}
Hi Ransi,
...Du kramst aber auch ein Zeugs aus der Ecke ;-)
Jetzt miss doch mal die verschiedenen Tempi (Quicksort, ListView, System.collections.Arraylist).
Das bekommst Du sicher auf die Schnelle hin. Bin mal gespannt.
Grüße Boris
AW: Tempomessung...
31.08.2008 16:32:00
ransi
HAllo
Zufallszahlen in A1:A1000:
Tabelle1

 A
18770
25193
31220
41621
51842
66278
79550
84380
92827
108043
112597
122709
137918
145029
157364
163736
171365
187609
193358


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Eine Userform mit einem ListView.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub testen()
Call Array_list
Call Quick_sort
Call List_View
End Sub

Public Sub Array_list()
Dim AL As Object
Dim arr
Dim L As Long
Dim T As Double
T = Timer
arr = WorksheetFunction.Transpose(Range("A1:A1000"))
Set AL = CreateObject("System.collections.Arraylist")
For L = 1 To UBound(arr)
    AL.Add arr(L)
Next
AL.Sort
For L = 1 To UBound(arr)
    arr(L) = AL.Item(L - 1)
Next
Range("B1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
Debug.Print "Array_List"; Timer - T
End Sub


'##########
Sub Quick_sort()
Dim arr
Dim T As Double
T = Timer
arr = WorksheetFunction.Transpose(Range("A1:A1000"))
Quicksort arr, 1, UBound(arr)
Range("C1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
Debug.Print "QuickSort"; Timer - T
End Sub


Private Function Quicksort(Data, links, rechts)
Dim Teiler As Long
If rechts > links Then
    Teiler = Teile(Data, links, rechts)
    Call Quicksort(Data, links, Teiler - 1)
    Call Quicksort(Data, Teiler + 1, rechts)
End If
End Function

Private Function Teile(Data, links, rechts)
Dim Index As Long
Dim i As Long
Index = links
For i = links To rechts - 1
    If Data(i) <= Data(rechts) Then
        Call Tausche(Data, Index, i)
        Index = Index + 1
    End If
Next
Call Tausche(Data, Index, rechts)
Teile = Index
End Function

Private Sub Tausche(Data, i, j)
Dim Temp As Double
Temp = Data(i)
Data(i) = Data(j)
Data(j) = Temp
End Sub

Public Sub List_View()
Dim arr
Dim L As Long
Dim T As Double
T = Timer
arr = WorksheetFunction.Transpose(Range("A1:A1000"))
With UserForm1.ListView1
    .ListItems.Clear
    For L = 1 To UBound(arr)
        .ListItems.Add(L) = arr(L)
    Next L
    .Sorted = True
    For L = 1 To .ListItems.Count
        arr(L) = .ListItems(L)
    Next
End With
Range("D1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
Debug.Print "ListView"; Timer - T
End Sub

Der Quicksort liegt erwartungsgemäß vorne ;-),
und das ListView sortiert 1000 vor 200 ein...
Viel Spaß beim Testen.
ransi
Anzeige
AW: Tempomessung...
01.09.2008 11:53:00
Peter
Hallo ransi,
wenn man das ListView ein klein wenig 'erweitert' sortiert er rasant schnell und vor allen Dingen in der richtigen Folge:

Public Sub List_View_I()
Dim arr     As Variant
Dim lIndex  As Long
Dim sWert   As String
Dim T       As Double
T = Timer
arr = WorksheetFunction.Transpose(Range("A1:A1000"))
With UserForm1.ListView1
.ListItems.Clear
For lIndex = 1 To UBound(arr)
Select Case Len(arr(lIndex))  ' für 4-stellige Zahlenwerte
Case 1: sWert = "   " & arr(lIndex)
Case 2: sWert = "  " & arr(lIndex)
Case 3: sWert = " " & arr(lIndex)
Case 4: sWert = arr(lIndex)
End Select
.ListItems.Add(lIndex) = sWert ' arr(lIndex)
Next lIndex
.Sorted = True
For lIndex = 1 To .ListItems.Count
arr(lIndex) = .ListItems(lIndex)
Next lIndex
End With
Range("E1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
Debug.Print "ListView_I"; Timer - T
End Sub


Gruß Peter

Anzeige
AW: Sortieren
31.08.2008 21:52:00
Daniel
Hi
das einfachste Programm zum sortieren von Daten in Excel läuft nach folgendem Schema ab:
- Daten in eine Exceltabelle kopieren
- Exceltabelle mit der Funktion .SORT von Excel sortieren lassen
- sortierte Daten wieder ins Array kopieren
warum grossartig Gedanken über das Sortiern machen, wenn Excel diese Funktion schon fest eingebaut hat?
Gruß, Daniel
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige