| |
| In diesem Forum haben Sie die Möglichkeit Kommentare, Fragen und Verbesserungsvorschläge zu den im vb@rchiv gelisteten Tipps und Workshops zu posten.
Hinweis: Ein neues Thema kann immer nur über die jeweilige Tipps & Tricks bzw. Workshop Seite eröffnet werden! | Fragen zu Tipps & Tricks und Workshops im vb@rchivErgänzung? | | | Autor: erich1961 | Datum: 07.03.10 09:03 |
| Hallo,
ich stand vor dem Problem, daß ich nicht wusste, wie groß mein Array werden wird. Bei mir waren die die Zeilen in der 2. Dimension und die Spalten in der Ersten.
Folgendes funktioniert soweit, bis auf den Index (der muß 1 höher sein als die zu sortierende Spalte:
Public Sub QuickSortMultiDim(vSort As Variant, Optional ByVal index As Integer = 1, Optional ByVal lngStart As Variant, Optional ByVal lngEnd As Variant)
' Wird die Bereichsgrenze nicht angegeben,
' so wird das gesamte Array sortiert
If IsMissing(lngStart) Then lngStart = LBound(vSort, 2)
If IsMissing(lngEnd) Then lngEnd = UBound(vSort, 2)
Dim i As Long
Dim j As Long
Dim h As Variant
Dim x As Variant
Dim u As Long
Dim lb_dim As Integer
Dim ub_dim As Integer
' Anzahl Elemente pro Datenzeile
lb_dim = LBound(vSort)
ub_dim = UBound(vSort)
i = lngStart: j = lngEnd
x = vSort(index - 1, (lngStart + lngEnd) / 2)
' Array aufteilen
Do
While (vSort(index - 1, i) < x): i = i + 1: Wend
While (vSort(index - 1, j) > x): j = j - 1: Wend
If (i <= j) Then
' Wertepaare miteinander tauschen
For u = lb_dim To ub_dim
h = vSort(u, i)
vSort(u, i) = vSort(u, j)
vSort(u, j) = h
Next u
i = i + 1: j = j - 1
End If
Loop Until (i > j)
' Rekursion (Funktion ruft sich selbst auf)
If (lngStart < j) Then QuickSortMultiDim vSort, index, lngStart, j
If (i < lngEnd) Then QuickSortMultiDim vSort, index, i, lngEnd
End Sub | |
| Sie sind nicht angemeldet! Um einen neuen Beitrag schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats 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-2024 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
|
|