Elemente jeglicher Art in der gewünschten Reihenfolge

    • VBA: Sonstige

    Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von warbe.

      Elemente jeglicher Art in der gewünschten Reihenfolge

      In vielen Fällen ist es wünschswert, Listen-Elemente jeweder Art in einer bestimmten Reihenfolge vorliegen zu haben. Dazu gibt es vielfältige Möglichkeiten, die alle Vor- und Nachteile haben. Viele davon bieten sich für das nachträgliche Sortieren einer unsortierten Liste an. Ich benötige zu diesem Zweck in einer Schleife nur die Anweisung:

      Visual Basic-Quellcode

      1. dctAdd dct, vKey, vItem, dam_ascending

      um, was auch immer sich in vItem befindet (String, Objekt, etc.), in dct, nach dem vKey (ein String oder numerischer Wert), im vorliegenden Fall aufsteigend sortiert, vorliegen zu haben.
      Der Inhalt von dct kann am Ende der Schleife mit

      Visual Basic-Quellcode

      1. For Each v In dct
      2. Next v

      weiter bearbeitet werden. Hierzu sind Kenntnisse bzgl. des Umgangs mit Scripting.Dictionaries erforderlich, die aber ganz ähnlich derer für Collections sind. Die Liste liegt also zu jedem Zeitpunkt bereits sortiert vor. Seitdem es so einfach ist, benutze ich fast nur noch sortierte Listen, zumal wenn es sich nicht um tausende von Elementen handelt, wo dann irgendwann dctAdd aus Performancegründen nicht mehr adäquat ist. Die Verwendung ist denkbar einfach:

      1. Den folgenden Code in ein Standard Modul oder ein Klassen Modul kopieren:

      Visual Basic-Quellcode

      1. Private Sub DctAdd(ByRef dct As Scripting.Dictionary, _
      2. ByVal vKey As Variant, _
      3. ByVal vItem As Variant, _
      4. ByVal lMode As enAddInsertMode, _
      5. Optional ByVal vTarget As Variant)
      6. ' -----------------------------------------------------
      7. ' "Universal" method to add an item to the Dictionary
      8. ' 'dct', supporting ascending and descending order,
      9. ' case or case insensitive key, as well as adding items
      10. ' before or after an existing item.
      11. ' Notes: - When an item with the key 'vKey' already
      12. ' exists, adding will just be skipped without
      13. ' an error.
      14. ' - The 'dct' dictionary is setup if yet no done
      15. '
      16. ' W. Rauschenberger, Berlin, Mar 2015
      17. ' -----------------------------------------------------
      18. Dim i As Long
      19. Dim dctTemp As Scripting.Dictionary
      20. Dim vTempKey As Variant
      21. Dim bAdd As Boolean
      23. If dct Is Nothing Then Set dct = New Dictionary
      25. With dct
      26. If .Count = 0 Or lMode = dam_sequence Then
      27. '~~> Very first item is just added
      28. .Add vKey, vItem
      29. Exit Sub
      30. Else
      31. '~~> Add item after the last one if appropriate
      32. vTempKey = .Keys()(.Count - 1)
      33. Select Case lMode
      34. Case dam_ascending
      35. If vKey > vTempKey Then
      36. .Add vKey, vItem
      37. Exit Sub ' Done!
      38. End If
      39. Case dam_ascendingignorecase
      40. If LCase(vKey) > LCase(vTempKey) Then
      41. .Add vKey, vItem
      42. Exit Sub ' Done!
      43. End If
      44. Case dam_descending
      45. If vKey < vTempKey Then
      46. .Add vKey, vItem
      47. Exit Sub ' Done!
      48. End If
      49. Case dam_descendingignorecase
      50. If LCase(vKey) < LCase(vTempKey) Then
      51. .Add vKey, vItem
      52. Exit Sub ' Done!
      53. End If
      54. End Select
      55. End If
      56. End With
      58. ' ----------------------------------------------
      59. ' Since the new key could not simply be added
      60. ' to the dct it must be added/inserted somewhere
      61. ' in between or even before the very first key.
      62. ' ----------------------------------------------
      63. Set dctTemp = New Dictionary
      64. bAdd = True
      65. For Each vTempKey In dct
      66. With dctTemp
      67. If bAdd Then
      68. '~~> Skip this section when already added
      69. If dct.Exists(vKey) Then
      70. '~~> Simply ignore add when already existing
      71. bAdd = False
      72. Exit Sub
      73. End If
      74. Select Case lMode
      75. Case dam_ascending
      76. If vTempKey > vKey Then
      77. .Add vKey, vItem
      78. bAdd = False ' Add done
      79. End If
      80. Case dam_ascendingignorecase
      81. If LCase(vTempKey) > LCase(vKey) Then
      82. .Add vKey, vItem
      83. bAdd = False ' Add done
      84. End If
      85. Case dam_addbefore
      86. If vTempKey = vTarget Then
      87. '~~> Add before vTarget key has been reached
      88. .Add vKey, vItem
      89. bAdd = True
      90. End If
      91. Case dam_descending
      92. If vTempKey < vKey Then
      93. .Add vKey, vItem
      94. bAdd = False ' Add done
      95. End If
      96. Case dam_descendingignorecase
      97. If LCase(vTempKey) < LCase(vKey) Then
      98. .Add vKey, vItem
      99. bAdd = False ' Add done
      100. End If
      101. End Select
      102. End If
      104. '~~> Transfer the existing item to the temporary dictionary
      105. .Add vTempKey, dct.Item(vTempKey)
      107. If lMode = dam_addafter And bAdd Then
      108. If vTempKey = vTarget Then
      109. ' ----------------------------------------
      110. ' Just add when lMode indicates add after,
      111. ' and the vTraget key has been reached
      112. ' ----------------------------------------
      113. .Add vKey, vItem
      114. bAdd = False
      115. End If
      116. End If
      118. End With
      119. Next vTempKey
      121. '~~> Return the temporary dictionary with the new item added
      122. Set dct = dctTemp
      123. Set dctTemp = Nothing
      124. Exit Sub
      126. End Sub


      2. Die folgenden Deklarationen in ein Standard Modul kopieren (oder, falls dctAdd nur in einer Klasse benötigt wird, ebenfalls in diese):

      Visual Basic-Quellcode

      1. Private Enum enAddInsertMode ' DctAdd modes
      2. dam_addafter = 1
      3. dam_addbefore = 2
      4. dam_ascending = 3
      5. dam_ascendingignorecase = 4
      6. dam_descending = 5
      7. dam_descendingignorecase = 6
      8. dam_sequence = 7
      9. End Enum


      3. Die Referenz Microsoft Scripting Runtime dem VBA-Projekt hinzufügen - und nie mehr unsortierte Listen haben.

      Anmerkungen zur Implementierung:
      • Wegen der vielfältigen Vorteile verwende ich (nicht nur) für meine sortierten Listen grundsätzlich ein Scripting.Dictionary. Dasselbe mit einer Collection zu realisieren wäre zwar möglich, aber etwas umstädlicher, da es keinen direkten Zugriff auf die Schlüssel gibt.
      • Eine Arbeitsmappe, die auch einen umfänglichen Perfromance-Test enthält, reiche ich auf Wunsch gerne nach. Die Verwendung ist aber dermaßen einfach, dass es genauso gut möglich ist dctAdd einfach mal auf die Schnelle auszuprobieren.
      • Wird der dctAdd und die Deklaration in ein Standard Modul kopiert, ist Private natürlich auf Public zu ändern.

      Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „warbe“ ()

      warbe schrieb:

      ByRef dct As Scripting.Dictionary, _
      ByRef vKey As Variant, _
      ByRef vItem As Variant, _


      Wieso ByRef?
      Bei dct erachte ich es für falsch.
      Bei vKey und vItem ist es unnötig, da es innerhalb der Prozedur nicht verändert wird.
      Oder habe ich etwas übersehen?
      --
      If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
      --

      Danke für diesen Hinweis. Mit dct ist die Liste des Aufrufers gemeint, die durch dctAdd immer sortiert zurückgegebn wird (vgl. Z. 122).
      ByRef für vKey u. vItem ist unnötig bzw. verwirrend weshalb ich das postwendend geändert habe.

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „warbe“ ()

      Normalerweise löst man das aber so, dass man ein Dictionary übergibt das man modifiziert und sortiert.
      Falls ein neues Dictionary daraus entstehen soll, gibt man das als Funktionswert zurück.
      In beiden Fällen reicht für die Übergabe des Dictionaries ein ByVal.
      Deine Methode, ein Dictionary ByRef zu übergeben und durch ein neues zu ersetzen ist zumindest sehr unüblich.
      --
      If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
      --

      Vielen Dank für den Hinweis. Das Dictionary muss natürlich vom Aufrufer definiert worden und übergeben sein. Falls es jedoch noch Nothing ist, wird es von dctAdd kurzerhand mit New angelegt. Die Rückgabe dieses neuen Dictionary klappt aber nur (hab's extra ausprobiert) mittels ByRef. Da ich damit eine Fehlerbehandlung spare, dient ByRef hier der Stabilität bzw. Robustheit der Lösung. Alleine aus diesen Gründen möchte ich trotz Unüblichkeit daran (noch) festhalten.

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „warbe“ ()

      ByRef wird üblicherweise nur dann verwendet, wenn zusätzliche Rückgabewerte benötigt werden.
      Die Hauptrückgabe erfolgt als Funktionswert.

      Funktioniert dein jetziger Code?
      Ich hätte jetzt folgende Signatur erwartet:

      Visual Basic-Quellcode

      1. Private Function DctAdd(ByVal dct As Scripting.Dictionary, ByVal vKey As Variant, ByVal vItem As Variant, ByVal lMode As enAddInsertMode, Optional ByVal vTarget As Variant) As Scripting.Dictionary
      2. '... hier den ganzen Code
      3. 'die Rückgabe:
      4. 'Set dct = dctTemp 'nicht den ByVal-Parameter verändern
      5. Set DctAdd = dctTemp 'als Funktionswert zurückgeben
      6. End Function
      --
      If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
      --

      Guter Vorschlag. Unter der Annahme, das Dictionary ist mit Dim dct As Scripting.Dictionary deklariert, ergäbe sich daraus
      Set dct = dctAdd(dct, key, item, ...). Ich benutze dctAdd seit mehreren Jahren und mir gefällt meine Aufrufsyntax - der auch von mir respektierten Lehrmeinung zum trotz - schlicht besser. Nicht zuletzt weil das Statement dctAdd dct, key, item , .... der Dictionary Add Methode dct.Add key, item sehr viel ähnlicher ist. Ich wäre vielmer an einer Erweiterung der Art interessiert, dass eine Prozedur AddItOrdered eine Collection mit einschließt. dct wäre schlicht list As Variant. Die Prozedur berücksichtigt im ganzen Code den tatsächlichen Typ.

      Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „warbe“ ()

    Facebook
    Telefonspende