Nachfolgender Funktion "SortData" werden mit einem 2-dimensionalen VariantArray die Position und das zu sortierende Element übergeben. In vArray(x,0) steht die Position bzw. Satz- oder Stellungsnumer in einer Datendatei, Tabelle oder ähnlichem. In vArray(x,1) steht das zu sortierende Element (z.B. UDT). Man liest die zu sortierende Information in ein Array ein, d.h. nur ein Teil (Element, Spalte usw.) und übergibt es der Funktion. Es wird also weniger Speicher benötigt als wenn man die gesamte Information übergeben würde, was sich in der Geschwindigkeit deutlich bemerkbar macht. Mit dem Rückgabe_Array kann dann beispielsweise aus einer Datei der entsprechende Datensatz [vArray(x,0)] gelesen werden. ' TestAufruf Private Function UnSortData() As Integer Dim A As Integer ' Anzahl Daten Dim I As Integer Dim J As Integer Dim U As Integer Dim Z As Double Dim vArray() As Variant Dim vText As Variant Dim vZeit As Variant Dim vResult As Variant On Error GoTo Err_UnSort A = 100 vResult = InputBox("geben Sie eine Zahl von 100 bis 500 ein", _ "SortierFunktionsTest", A) If vResult = "" Then A = 100 Else A = CLng(vResult) End If ' 2-Dimensionales Variant_Array ReDim vArray(1 To A, 1) ' Beispiel_Daten For I = 1 To A vArray(I, 0) = I ' Position vor Sortieren vArray(I, 1) = (A - I) + 1 Next I ' vorher: 100, 99, 98, 97, ... Z = Timer SortData vArray Z = Timer - Z ' nachher: 1, 2, 3, 4, 5, ... vText = vText & "vArray(X, 0) vArray(X, 1)" & vbCr & vbCr For I = 1 To A J = vArray(I, 0) ' Position nach Sortieren If I <= 10 Then vText = vText & J & Space(15) & vArray(I, 1) & vbCr Else Exit For End If Next I vZeit = Format(Z, "0.00") vZeit = vZeit & " sec" vText = vText & vbCr & vZeit MsgBox vText, vbInformation, "Sortierte Daten" ' Windows XP, Microsoft Network ' ' Zeiten ' A=500 : 3.61 sec ' A=400 : 1.88 sec ' A=300 : 0.80 sec ' A=200 : 0.23 sec ' A=100 : 0.03 sec Exit_UnSort: Exit Function Err_UnSort: MsgBox Err & vbCr & Err.Description, , "UnSortData" Resume Exit_UnSort End Function ' Um große Datenmengen zu sortieren, z.B. aus Dateien, Tabellen, usw., ' wird der zu sortierende Begriff (Element o. Spaltenwert) mit seiner ' Position(Stellung) in einem 2-dimensionalen varArray an diese ' Funktion übergeben. ' ' Die Funktion sortiert den Begriff(vArray(X,1) und gibt quasi die ' Position(vArray(X,0) zurück. ' ' Algorithmus: abgewandeltes Austauschverfahren: ' sortiert aufsteigend (>) ' Function SortData(vArray As Variant) As Long Dim A As Variant Dim B As Variant Dim C As Long Dim I As Long Dim J As Long Dim K As Long Dim L As Long Dim UB As Long Dim Z As Long Dim Min As Long Dim min0 As Variant Dim min1 As Variant Dim LX() As Variant On Error GoTo Err_SortData UB = UBound(vArray) L = UB ReDim LX(1 To L, 1) ' dimensionieren, temp.Array For I = 1 To L ' einlesen LX(I, 0) = vArray(I, 0) ' Position, SatzNr LX(I, 1) = vArray(I, 1) ' zu sort.Begriff Next I ' #Sort Do K = 0 For I = 1 To L Min = I A = LX(I, 1) ' zu sort.Begriff For J = I + 1 To L B = LX(J, 1) ' tausche wenn B < A If B < A Then Min = J K = J Exit For End If Next J If Min > I Then min0 = LX(Min, 0) min1 = LX(Min, 1) LX(Min, 0) = LX(I, 0) LX(Min, 1) = LX(I, 1) LX(I, 0) = min0 LX(I, 1) = min1 End If Next I Z = Z + 1 Loop Until K = 0 For I = 1 To L ' rückschreiben vArray(I, 0) = LX(I, 0) vArray(I, 1) = LX(I, 1) Next I ' #Sort Exit_SortData: Erase LX Exit Function Err_SortData: ' ErrDatei Err, MODASSI & "SortData" MsgBox Err.Number & vbcr & Err.Description Resume Exit_SortData End Function Dieser Tipp wurde bereits 8.390 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |