Differences

This shows you the differences between two versions of the page.

--- vba:functions:multisort [18.10.2019 10:06:34]
yaslaw [Einfaches Beispiel mit 2 Arrays]
+++ vba:functions:multisort [18.10.2019 10:45:44] (current)
yaslaw
@@ Line 25: / Line 25: @@
 </code>
 ==== Parameter-Liste ====
-  ***ioSortArr** Dieser Array wird sortiert
+  ***ioSortArr** Dieser Array wird sortiert. Hier darf es sich nicht um Objekte oder Udt handeln!
   ***ioSecArr** Dieser Array wird mitsortiert, paralell zum Ersten
   ***iSortOder** Angabe der Sortierrichtung
@@ Line 41: / Line 41: @@
 > Für die Ausgabe der Resultate verwendete ich die Funktion [[vba:functions:print_r:index]]
-==== Einfaches Beispiel mit 2 Arrays ====
+==== Beispiele mit 2 Arrays ====
+=== 2 gleich grosse Arrays ===
 Arrays. Der Erste wird sortiert und der Zweite entsprechend nachgeführt
 <code=vb>a = array("a", "d", "b", "c")
@@ Line 65: / Line 66: @@
 )</code>
+=== 2 verschieden grosse Arrays ===
 Wieder 2 Arrays, jedoch sind sie verscheiden gross
 <code>'Der Erste ist grösser, der Zweite wird soweit mitsortiert wie Einträge vorhanden sind
@@ Line 89: / Line 91: @@
 ? join(b, ", ")
 , 100, 99, 1</code>
+=== Index beginnt nicht bei 0 ===
+<code vb>Public Sub testMs()
+    Dim a() As Variant: ReDim a(1 To 3)
+    a(1) = "abc"
+    a(2) = Null
+    a(3) = 1234
+    Dim b() As Variant: ReDim b(4 To 7)
+    b(4) = "NR. 4"
+    b(5) = "NR. 5"
+    b(6) = "NR. 6"
+    b(7) = "NR. 7"
+    Debug.Print multiSort(a, b)
+    Debug.Print "Array a:"
+    print_r a
+    Debug.Print "Array b:"
+    print_r b
+End Sub</code>
+<code>True
+Array a:
+<Variant()>  (
+    [#1] => <Null>
+    [#2] => <Integer> 1234
+    [#3] => <String> 'abc'
+)
+Array b:
+<Variant()>  (
+    [#4] => <String> 'NR. 5'
+    [#5] => <String> 'NR. 6'
+    [#6] => <String> 'NR. 4'
+    [#7] => <String> 'NR. 7'
+)</code>
+==== Array mit Objekten nach einer Objekteigenschaft sortieren ====
+Wir haben ein Array mit Objekten. Dieses wollen wir nach einer Objekteigenschaft sortieren.
+\\ Ich nehme für das Beispiel [[vba:classes:date:datetime:index|]]
+<code vb>    'Beispieldaten
+    Dim objList() As Variant:     ReDim objList(2)
+    Set objList(0) = DateTime(#1/1/2019#)
+    Set objList(1) = DateTime(#5/1/2018#)
+    Set objList(2) = DateTime(#3/1/2020#)
+    'Property dateValue extrahieren.
+    Dim sortList() As Variant: ReDim sortList(LBound(objList) To UBound(objList))
+    Dim i&: For i = LBound(objList) To UBound(objList)
+        sortList(i) = objList(i).dateValue
+    Next i
+    'sortieren
+    multiSort sortList, objList
+    print_r objList</code>
+<code><Variant()>  (
+    [#0] => <Class Module::DateTime>  (
+        [timeStamp] => <Date> 01.05.2018
+        [unixTimeStamp] => <Long> 1525132800
+        [dateValue] => <Date> 01.05.2018
+        [timeValue] => <Date> 00:00:00
+	...
+    )
+    [#1] => <Class Module::DateTime>  (
+        [timeStamp] => <Date> 01.01.2019
+        [unixTimeStamp] => <Long> 1546300800
+        [dateValue] => <Date> 01.01.2019
+        [timeValue] => <Date> 00:00:00
+	...
+    )
+    [#2] => <Class Module::DateTime>  (
+        [timeStamp] => <Date> 01.03.2020
+        [unixTimeStamp] => <Long> 1583020800
+        [dateValue] => <Date> 01.03.2020
+        [timeValue] => <Date> 00:00:00
+	...
+    )
+)</code>
+==== Dictionary nach Value sortieren ====
+Damit kann man auch ein Dictionary sortieren
+<code vb>'/**
+' * Sortiert ein Dictionary nach den Einträgen
+' * @param  Dictionary
+' * @param  eSortOrder
+' * @return Dictionary
+' */
+Public Function sortDictByItems(ByRef ioDict As Object, Optional ByVal iSortOder As eSortOrder = sAscending) As Boolean
+On Error GoTo Err_Handler
+    Dim keys():     keys = ioDict.keys
+    Dim items():    items = ioDict.items
+    Dim i&
+    sortDictByItems = multiSort(items, keys)
+    If Not sortDictByItems Then Exit Function
+    Dim dict As Object: Set dict = CreateObject("scripting.Dictionary")
+    If iSortOder = sAscending Then
+        For i = 0 To UBound(keys)
+            dict.add keys(i), items(i)
+        Next i
+    Else
+        For i = UBound(keys) To 0 Step -1
+            dict.add keys(i), items(i)
+        Next i
+    End If
+    Set ioDict = dict
+Exit_Handler:
+    Exit Function
+Err_Handler:
+    Debug.Print "Error in multiQuickSort(): ", Err.Number, Err.Description
+    Resume Exit_Handler
+    Resume
+End Function</code>
+<code vb>Public Sub testDictSort()
+    Dim dict As New Dictionary
+    dict.add "a", 18974
+    dict.add "b", 156
+    dict.add "c", 99999
+    Debug.Print sortDictByItems(dict)
+    print_r dict
+End Sub</code>
+<code>True
+<Dictionary>  (
+    [b] => <Integer> 156
+    [a] => <Integer> 18974
+    [c] => <Long> 99999
+)</code>
 ===== Code =====
-<source '%%fpath%%/%%fname%%' vb>
+{{%%fname%%|Download %%fname%% (V-%%version%%)}}

Yaslaw.Info

User Tools

Site Tools

Differences

Page Tools