| |

Suche Visual-Basic CodeSortier-Routine für Zahlen gesucht | |  | Autor: Stefan | Datum: 29.08.02 22:31 |
| Such dringend ein Sortierprogramm, das Zahlenreihen sortieren kann.
Ich habe einen Quellcode gefunden, der alphabetisch sortiert, das führt aber nicht zum gewünchten Ergebnis. Unter einer Zahlenreihe verstehe ich x(1); x(2); x(3); usw.
zusätzlich gibt es für jeden x-Wert noch einen zugehörigen y-Wert, der, nachdem alle x-Werte sortiert sind auch noch sortiert werden soll. Vorerst bin ich schon mal glücklich, wenn mir jemand bei der Sortierung der x-Werte hilft. Den Rest bekomme ich dann vielleicht selber hin.
Hier noch der Quellcode für alphabetisches Sortieren. Vielleicht kann man das irgendwie modifizieren?
Das hier muß in der Form stehen:
'Sortiert einen Array nach alphabetischer Reihenfolge
Sub QuickSort(SortArray() As String, Optional ByVal varStart As Long, Optional ByVal varEnd As Long)
Dim i As Long, J As Long, RandIndex As Long, Partition As String
Dim Low As Long, High As Long
Low = IIf(varStart = 0, LBound(SortArray), varStart)
High = IIf(varEnd = 0, UBound(SortArray), varEnd)
If Low < High Then
If High - Low = 1 Then
If UCase(SortArray(Low)) > UCase(SortArray(High)) Then
Swap SortArray(Low), SortArray(High)
End If
Else
'Einen zufälligen Ausgangspunkt generieren
RandIndex = Rnd() * (High - Low) + Low
Swap SortArray(High), SortArray(RandIndex)
Partition = UCase(SortArray(High))
Do
'Von beiden Seiten auf den Ausgangspunkt "zugehen"
i = Low: J = High
Do While (i < J) And (UCase(SortArray(i)) <= Partition)
i = i + 1
Loop
Do While (J > i) And (UCase(SortArray(J)) >= Partition)
J = J - 1
Loop
'Wenn der Ausgangspunkt noch nicht erreicht ist, sind 2 Elemente auf
'beiden Seiten funktionsunfähig, deswegen werden sie vertauscht
If i < J Then
Swap SortArray(i), SortArray(J)
End If
Loop While i < J
'Den Ausgangspunkt zu seinem richtigen Platz im Array führen
Swap SortArray(i), SortArray(High)
'Die QuickSort-Routine rekursiv nochmals aufrufen
If (i - Low) < (High - i) Then
QuickSort SortArray, Low, i - 1
QuickSort SortArray, i + 1, High
Else
QuickSort SortArray, i + 1, High
QuickSort SortArray, Low, i - 1
End If
End If
End If
End Sub
'Vertauscht die Werte der zwei angegebenen Variablen
Private Sub Swap(First As String, Second As String)
Dim varTemp As String
varTemp = First
First = Second
Second = varTemp
End Sub
--------------------------------------------------------------------------
Auf der Form gibt es einen Command-Button (Command1), und 8 Textfelder
(Text1 - Text4 = Eingabefelder; Text5 - Text8 = Ausgabefelder)
Im Command-Button steht folgendes:
Private Sub Command1_Click()
Dim varArray(1 To 4) As String
varArray(1) = Text1
varArray(2) = Text2
varArray(3) = Text3
varArray(4) = Text4
QuickSort varArray
Text5.Text = varArray(1)
Text6.Text = varArray(2)
Text7.Text = varArray(3)
Text8.Text = varArray(4)
End Sub |  |
 | Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
  |
|
sevISDN 1.0 
Überwachung aller eingehender Anrufe!
Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Weitere InfosTipp des Monats Oktober 2025 Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Neu! sevPopUp 2.0 
Dynamische Kontextmenüs!
Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Weitere Infos
|
|
|
Copyright ©2000-2025 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|