Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1004to1008
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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!

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige