Dictionary, mehrere Werte zu einem Schlüssel

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
thowe
Beiträge: 209
Registriert: 12. Sep 2022, 16:57
Hat sich bedankt: 79 Mal
Danksagung erhalten: 67 Mal
Kontaktdaten:

Dictionary, mehrere Werte zu einem Schlüssel

#1

Beitrag von thowe »

Moin, Hallo & guten Moren!

Folgend eine kleine Spielerei (Playaround) mit Dictionaries:

Einführend was sind Dicitonaries?

In einfachen Wörtern: Es handeld sich um eine Wertepaar: Key:=, Item:= wobei Item den Wert zum Key darstellt.
Also zB: Key:= wks.Name, Item:= wks.Range("MyUsage").Value (Die Deklaration "wks" vorausgesetzt)

-----------------------------------------------------

Das besondere daran ist, dass man mit folgende beispielhafte - und vor allem ausbaufähige Lösung - mehrere Werte zu einem Schlüssel "binden" kann.
Grundsätzlich ist bei Dictionaries nur ein Wert pro Schlüssel (key) möglich.
Jetzt zeige ich euch am Beispiel Worksheets wie man mehrere Werte pro Arbeitsblatt (Worksheet) "herauszkitzeln" kann.

Dafür sind notwendig:

Ein Klassenmodul: clsSheet
Ein "normales" Modul: in meinem Beispiel: mdldPlayarounds_DICTIONARY

Gleich ziemlich am Anfang, lasst euch von diesem Blog inspirieren. Auch ich hatte mich anfänglich - gerne - daran orientiert, Danke an Paul Kelly.
https://excelmacromastery.com/vba-dictionary/

Auch am Anfang ein wichtiger HINWEIS: Dictionaries laufen nur unter Windows, nicht unter MacOS (!)

Der phänomenale Vorteil einer Dicitionary gegenüber Collection ist, dass man die Existenz/das Vorhandensein eines Key, out of the box, prüfen kann.
Für Collections müsste man eine eigene Function schreiben.

Jetzt endlich zum Code!

clsSheet
(dieses enthält nur ein paar selbst bestimmte Properties als "Variablen"

Code: Alles auswählen

Public Key As Variant
Public SheetName As String
Public SheetCodeName As String
Public SheetIndex As Long
Public SheetUsage  As String
mdlPlayarounds_DICTIONARY

Code: Alles auswählen

'Early binding Reference to Microsoft Scripting Runtime is neccesary
'Add using: Tools > References from the VB menu (Extras > Verweise)

Public m_dictSheets As New Scripting.Dictionary
Public objSheet As clsWorksheet


Sub DICTIONARY_PlayaroundsWorkSheet()
    
    Dim wkb As Workbook
    Dim wks As Worksheet
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Worksheets("Sheets")
    
    Dim varKey As Variant 'Variable: We need this to determine customized the key for the Dictionara
    
    Set objSheet = New clsWorksheet
    With objSheet
        'To keep it as simple as possible we take the Sheet.Name Property
        'or if you iterate through all Sheets in  this or another specific workbook, get the Index as .Key
        .Key = wks.Name
        'some other additional stuff
        .SheetIndex = wks.Index
        .SheetCodeName = wks.CodeName
        .SheetName = wks.Name 'this is redudand in this Case
        .SheetUsage = "only internal Dashboard"
    End With
    
    ' Add the new clsWorkSheet (Class)object to the dictionary
    m_dictSheets.Add objSheet.Key, objSheet
    
    For Each varKey In m_dictSheets.Keys
        ' Write to the Immediate Window [STRG] + [G]
        Debug.Print varKey
    Next varKey
    
End Sub

Das ist ein ganz einfach gehaltenes Beispiel mit nur einem Worksheet!
Wer noch nicht ganz so fit ist, kann im Einzelmodus [F8] durchgehen.
Gut ist es in diesem Fall, sich auch das Lokalfenster (Watch) zu öffnen. Ansicht > Lokalfenster.
Natürlich könnet man über die Arbeitsmappe mit

Code: Alles auswählen


For Each wks in ThisWorkbook.Sheets
	'some stuff like to chekc if the Key esists
	

            Set objSheet = New clsWorkSheet
            objSheet.Name = wks.Name
          	
            m_dictSheets.Add Key:=objItem.Name, Item:=objSheet
        
        With objSheet
            .Index = wksSheet.Index
            .CodeName = wksSheet.CodeName
	    '. ... = ...
        End With

Next wks 
iterieren und zu allen Arbeitsblättern "Daten sammeln".

Ich lasse das nun mal so wirken und freue mich auf eine denkbare angeregte Diskussion.
Viel Spaß bei herumbasteln und freue ich mich auf Rückmeldungen eurer Basteleien, mit sicher sinnvolleren Vorschlägen als meine VBAstelei.
clsWorkSheet.cls
(369 Bytes) Noch nie heruntergeladen
lg thowe
mdlPlayarounds_DICTIONARY.bas
(1.31 KiB) Noch nie heruntergeladen
lg thowe
Folgende Benutzer bedankten sich beim Autor thowe für den Beitrag (Insgesamt 2):
d'r Bastler, BitDoctor

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste