Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Scripting.Dictionary

Scripting.Dictionary
Peter
Hallo Excel-Experten,
ich versuche mich gerade am Scripting.Dictionary und möchte wissen, ob ich zu einem Key immer nur ein Item haben kann, oder ob es auch mehrere Items sein können.
Als einfaches Beispiel:
Nachname, Vorname, Straße, Pstlz, Ort
Also 5 Spalten, die nach dem Nachnamen als Key nur einmal vorkommen sollen, von denen aber die 4 anderen Zellen/Spalten einer Zeile mitgegeben werden sollen.
Oder muss ich den Nachnamen als Key verwenden und später die restlichen Daten z. B. per Find-Methode dazuholen?
Wie geschrieben: Es interessiert absolut keine andere Methode das ‚Problem’ zu lösen, es soll mit Scripting.Dictionary gelöst werden!
Für sachdienliche Hinweis schon jetzt vielen Dank im voraus.
Gruß Peter

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Scripting.Dictionary
18.09.2009 15:05:37
Peter
Hallo Karin,
den Beitrag hatte ich schon gefunden/gelesen, der hilft mir aber wenigstens zur Zeit nicht weiter.
Sieh Dir einmal die angehängte Mappe an. Das sollen die Verkäufernamen aus Spalte J in der Spalte O je einmal vorkommen, das Vorkommen (die Häufigkeit) in Spalte P und der Wert aus Spalte L zum Verkäufer neben der Häufigkeit in Spalte Q.
Gelöst habe ich es, nur eben meine Frage: Geht das eleganter - ohne Find-Methode?
https://www.herber.de/bbs/user/64533.xls
Gruß Peter
Anzeige
AW: Scripting.Dictionary
18.09.2009 15:05:44
ransi
HAllo
Das Dictionary frisst bei den Items so ziemlich alles was du anbietest.
Ein Beispiel.
DAs sind deine Daten:
Tabelle1

 ABCDE
1Daten 1Daten 2Daten 3Daten 4Daten 5
2MüllerZ708C6SUG6S9EUO2S624
3Meier1BTWNPSK3K67QEE53F7R
4Schulze6SR6TMRTNZIKV0XGNQWH
5Hinz18MMIRER71RWGYUX0VD8
6Müller73I60GJ7UNEZ4DKWV8SQ
7Meier6MZSTIAR348DR7JOOD85
8SchulzeZUPIF854UW2I4ZU2NLJ3
9HinzPW6708J8NADOUDC2T2SV
10Müller5SEOTMPQJXUGX7B5FSHG
11Meier7Y7VABR6L2CABGBFFDVL
12Schulze2GFSZ555UN6R4231IGGN
13HinzLTW1VZICS813XC11AOMX


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Jetzt diesen COde:
Option Explicit



Public Sub test()
Dim objDic As Object
Dim L As Long
Dim I As Variant
Set objDic = CreateObject("Scripting.Dictionary")
Dim Bereich As Range
Set Bereich = Range("A2:E13")
For L = 1 To 12
    objDic(Bereich(L, 1).Value) = Range(Cells(L, 2), Cells(L, 5)).Value
Next
I = objDic.items
End Sub



Setz bei End Sub mal einen Haltepunkt, und schau dir im Lokalfenster den Inhalt der Variable I an.
ransi
Anzeige
AW: Scripting.Dictionary
18.09.2009 15:26:12
Peter
Hallo ransi,
danke erstmal für Deine Unterstützung.
Nur, wo lasse ich das Zählen der Häufigkeit in dem Variant, der da gebildet wird?
Gruß Peter
AW: Scripting.Dictionary
18.09.2009 15:30:12
ransi
HAllo Peter
Ich hatte deine BEispieldatei noch nicht gesehen als ich gepostet habe.
Schau dir mal den Link in meinem anderen Post an.
ransi
AW: Scripting.Dictionary
18.09.2009 17:56:16
Peter
Hallo ransi,
wie ich mir bereits gedacht habe, muss ich ein 2. Dictionary bauen.
Danke und Gruß
Peter
AW: Scripting.Dictionary
18.09.2009 22:19:46
bst
Abend auch,
nein, musst Du nicht, siehe Link von Beverly. Als Item im Dictionary kannst Du auch ein Array oder eine Klasse benutzen.
Hier die Variante mit einer 'einfachst gehaltenen Klasse' mit dem Namen myClass:
Option Explicit
Public Count As Long
Public Center As Integer
Damit geht dann sowas. Der Einfachkeit halber habe ich Dein aTemp auf 3 Spalten vergrössert.
Option Explicit
'
' Die Verkäufer nur einmal zählen und die Anzahl Vorkommen ausgeben
' Public Sub NachVerkaeufer() Dim WkSh As Worksheet Dim lLetzte As Long Dim aTemp As Variant Dim lZeile As Long Dim rZelle As Range Dim Dict_1 As Variant Dim cl As myClass Dim varKey As Variant Set WkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen ' die letzte belegte Zelle der Herkunfts-Daten ermitteln lLetzte = WkSh.Cells(Rows.Count, 10).End(xlUp).Row ' die Daten in ein temporäres Araay laden aTemp = WkSh.Range("J12:L" & lLetzte) ' den Ausgabebereich 'großzügig' löschen WkSh.Range("O12:Q100").ClearContents ' auf das Scripting.Dichtionary verweisen Set Dict_1 = CreateObject("Scripting.Dictionary") On Error Resume Next ' das Dictionary mit Daten aus der Matrix aTemp befüllen ' dabei wird jeder Name nur einmal eingestellt, das Vorkommen aber gezählt For lZeile = 1 To UBound(aTemp) varKey = aTemp(lZeile, 1) ' der Key ins Dictionary If Dict_1.Exists(varKey) Then ' falls existent das zugehörige Klassenobjekt holen Set cl = Dict_1(varKey) Else Set cl = New myClass ' ansonsten eine neues Klassenobjekt ankegen und befü _ llen cl.Center = aTemp(lZeile, 3) Dict_1.Add varKey, cl End If cl.Count = cl.Count + 1 ' und dann noch zählen ... Next lZeile ' ausgeben Set rZelle = WkSh.Cells(12, 15) ' Ausgabe ab Zelle "O12" Application.EnableEvents = False rZelle.Resize(Dict_1.Count) = WorksheetFunction.Transpose(Dict_1.Keys) lZeile = 12 For Each varKey In Dict_1 Set cl = Dict_1(varKey) WkSh.Cells(lZeile, 16).Value = cl.Count WkSh.Cells(lZeile, 17).Value = cl.Center lZeile = lZeile + 1 Next Application.EnableEvents = True End Sub HTH, Bernd
Anzeige
AW: Scripting.Dictionary
18.09.2009 22:37:48
Peter
Hallo Bernd,
vielen Dank für Deine Lösung, die gefällt mir von den dreien, die ich jetzt habe (mit Find-Methode, mit 2 Dictionary und nun Deine) am besten.
So lerne ich immer noch dazu - ich bin begeistert.
Gruß Peter
AW: Scripting.Dictionary
18.09.2009 23:20:01
bst
Abend Peter,
Bitteschön und freut mich wenn's gefällt.
FWIW, hier noch einer Variante mit einem Array.
cu, Bernd
--
Option Explicit
'
' Die Verkäufer nur einmal zählen und die Anzahl Vorkommen ausgeben
'
Public Sub NachVerkaeufer()
Dim WkSh     As Worksheet
Dim lLetzte  As Long
Dim aTemp    As Variant
Dim lZeile   As Long
Dim rZelle   As Range
Dim Dict_1   As Variant
Dim ar       As Variant
Dim varKey   As Variant
Set WkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen
'     die letzte belegte Zelle der Herkunfts-Daten ermitteln
lLetzte = WkSh.Cells(Rows.Count, 10).End(xlUp).Row
'     die Daten in ein temporäres Araay laden
aTemp = WkSh.Range("J12:L" & lLetzte)
'     den Ausgabebereich 'großzügig' löschen
WkSh.Range("O12:Q100").ClearContents
'     auf das Scripting.Dichtionary verweisen
Set Dict_1 = CreateObject("Scripting.Dictionary")
'On Error Resume Next
'     das Dictionary mit Daten aus der Matrix aTemp befüllen
'     dabei wird jeder Name nur einmal eingestellt, das Vorkommen aber gezählt
For lZeile = 1 To UBound(aTemp)
varKey = aTemp(lZeile, 1)        ' der Key ins Dictionary
If Dict_1.Exists(varKey) Then    ' zählen
ar = Dict_1(varKey)
ar(0) = ar(0) + 1
Dict_1(varKey) = ar
' Dict_1(varKey)(0) = Dict_1(varKey)(0) + 1 ' funktioniert leider nicht, warum  _
eigentlich ?
Else
Dict_1.Add varKey, Array(1, aTemp(lZeile, 3))
End If
Next lZeile
'    ausgeben
Set rZelle = WkSh.Cells(12, 15)  ' Ausgabe ab Zelle "O12"
Application.EnableEvents = False
rZelle.Resize(Dict_1.Count) = WorksheetFunction.Transpose(Dict_1.Keys)
lZeile = 12
For Each varKey In Dict_1
ar = Dict_1(varKey)
WkSh.Cells(lZeile, 16).Value = ar(0)
WkSh.Cells(lZeile, 17).Value = ar(1)
lZeile = lZeile + 1
Next
Application.EnableEvents = True
End Sub

Anzeige
Scripting.Dictionary mit Hochzählen
19.09.2009 01:37:44
Erich
Hi Peter,
Bernds neue Version hab ich noch ein wenig gekürzt:

Public Sub NachVerkaeufer3()
Dim aTemp    As Variant
Dim Dict_1   As Variant
Dim lngZ     As Long
Dim varKey   As Variant
Dim ar       As Variant
With ThisWorkbook.Worksheets("Tabelle1")     ' Blatt evtl. anpassen
aTemp = .Range("J12:L" & .Cells(.Rows.Count, 10).End(xlUp).Row) 'Daten in aTemp
.Range("O12:Q100").ClearContents          ' Ausgabebereich löschen
Set Dict_1 = CreateObject("Scripting.Dictionary")
'     das Dictionary mit Daten aus der Matrix aTemp befüllen
'     dabei wird jeder Name nur einmal eingestellt, das Vorkommen aber gezählt
For lngZ = 1 To UBound(aTemp)
varKey = aTemp(lngZ, 1)          ' nächster Key aus Quelle
If Dict_1.Exists(varKey) Then    ' schon da ?
ar = Dict_1(varKey)                          ' ar auslesen
ar(0) = ar(0) + 1                            ' hochzählen
Dict_1(varKey) = ar                          ' ar ablegen
Else
Dict_1.Add varKey, Array(1, aTemp(lngZ, 3))  ' Neuanlage
End If
Next lngZ
' Ausgabe ab Zelle "O12"
Application.EnableEvents = False
.Cells(12, 15).Resize(Dict_1.Count) = Application.Transpose(Dict_1.Keys)
lngZ = 12
For Each varKey In Dict_1
.Cells(lngZ, 16).Value = Dict_1(varKey)(0)
.Cells(lngZ, 17).Value = Dict_1(varKey)(1)
lngZ = lngZ + 1
Next
Application.EnableEvents = True
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Scripting.Dictionary mit Hochzählen
19.09.2009 11:12:32
Peter
Hallo Bernd, hallo Erich,
danke für Euere Lösungen. Vier Varianten für eine Aufgabe sind nicht oft der Fall.
Euch ein schönes Wochenende,
Gruß Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen