Dizionario di script VBA, più elementi per chiave e somma/conteggio sugli articoli

Question

Desidero creare un dizionario con più elementi per chiave. Di seguito è riportato il codice con cui sto lavorando ora. Ho trascorso più di 7 ore a giocare con il dizionario e non riesco a capirlo. Non ho problemi a ottenere i valori univoci da un mio intervallo di input come chiavi del mio dizionario, il problema arriva quando voglio aggiungere elementi a ciascuna chiave. Se la chiave esiste già, desidero SUM (o aggiungere) all'elemento di quella chiave, o aumentare il "conteggio" per quella chiave, che verrebbe memorizzata in un altro elemento di quella chiave. Forse è meglio spiegato attraverso le immagini.

Key  Item1  Item2 
PersonA 20   SomeOtherVal 
PersonB 40   SomeOtherVal 
PersonA 80   SomeOtherVal 
PersonB 17   SomeOtherVal 
PersonC 13   SomeOtherVal 

Result: 
Key  Item1(Sum) Item2(Count) 
PersonA 100  2 
PersonB 57   2 
PersonC 13   1 

Quindi, come potete vedere, tutti gli oggetti unici esistenti vengono creati come una propria chiave. Se la chiave esiste già, l'elemento 1 viene aggiunto al totale corrente della chiave, l'articolo 2 ha un conteggio e viene aumentato di 1. Di seguito è riportato il codice con cui sto lavorando, Appreico la tua assistenza.

Sub dictionaryCreate() 

Dim Pair As Variant 
Dim q As Range 
Dim RAWDATA As Range 

Dim d As Dictionary        'Object 
Set d = New Dictionary       'CreateObject("Scripting.Dictionary") 

Set RAWDATA = Worksheets("RAW_DATA").Range(Cells(2, 1), Cells(3000, 1)) 
For Each q In RAWDATA 
    Pair = q.Offset(0, 60).Value + q.Offset(0, 65).Value 
    If d.Exists(Pair) Then 
     'ADD to item1 SUM 
     'Add to item2 COUNT 
    Else 
     d(Pair) = 1 'create new key 
    End If 
Next 

End Sub 

Answer 1

Un oggetto di classe è ideale per questa attività. Per prima cosa puoi creare i tuoi campi dati, per un altro puoi aggiungere ulteriori funzionalità (es. Memorizzare ogni singolo oggetto o avere una funzione che calcola la somma e il conteggio) e, soprattutto, puoi eseguire funzioni aritmetiche sui campi (come come aggiunta).

Quest'ultimo è molto utile perché i tipi di dati primitivi non possono essere modificati in un tipo di oggetto Collection. Ad esempio non è possibile avere nel codice d(key) = d(key) + 1 se l'articolo in d è, ad esempio, un Integer. Dovresti leggere il valore di d(key) in una variabile temporanea, incrementarlo di 1, rimuovere il vecchio valore e quindi aggiungere la nuova variabile temporanea (e se l'ordine nello Collection è importante per te allora hai un compito ancora più difficile). Tuttavia, gli oggetti sono memorizzati per riferimento in questi tipi di Collections, quindi è possibile modificare le proprietà di tale oggetto sul contenuto del cuore.

Noterete che ho fatto riferimento a Collection più di . Questo perché ritengo che le tue esigenze siano più adatte a un Collection: a) Prendo atto che i tuoi dati grezzi potrebbero essere piuttosto grandi (forse oltre 3000 voci), e credo che aggiungere a un Collection sia più veloce, e b) non vorresti avere il problema di fare riferimento alla libreria Runtime.

Di seguito è riportato un esempio di oggetto di classe con un paio di funzioni aggiuntive per mostrare come potrebbe funzionare.Si crea nel vostro editor con Inserire ~> modulo di classe Ho chiamato questa classe cItems nella nome della finestra proprietà:

Public Key As String 
Public Sum As Long 
Public Count As Long 
Public ItemList As Collection 
Public Function Mean() As Double 
    Mean = Sum/Count 
End Function 
Private Sub Class_Initialize() 
    Sum = 0 
    Count = 0 
    Set ItemList = New Collection 
End Sub 

Si potrebbe quindi aggiungere gli elementi alla tua collezione nel vostro modulo principale come segue:

Dim col As Collection 
Dim dataItems As cItems 
Dim itemKey As String 
Dim item1 As Long 
Dim ws As Worksheet 
Dim r As Long 

Set ws = ThisWorkbook.Worksheets("RAW_DATA") 
Set col = New Collection 

For r = 2 To 3000 
    itemKey = CStr(ws.Cells(r, "A").Value2) '~~adjust to your own column(s) 
    item1 = CLng(ws.Cells(r, "B").Value2) '~~adjust to your own column(s) 

    'Check if key already exists 
    Set dataItems = Nothing: On Error Resume Next 
    Set dataItems = col(itemKey): On Error GoTo 0 

    'If key doesn't exist, create a new class object 
    If dataItems Is Nothing Then 
     Set dataItems = New cItems 
     dataItems.Key = itemKey 
     col.Add dataItems, itemKey 
    End If 

    'Add cell values to the class object 
    With dataItems 
     .Sum = .Sum + item1 
     .Count = .Count + 1 
     .ItemList.Add item1 
    End With 

Next 

Se si voleva accedere a uno o tutti gli elementi che ci si fa in questo modo:

'Iterating through all of the items 
For Each dataItems In col 
    Debug.Print dataItems.Mean 
Next 

'Selecting one item 
Set dataItems = col("PersonA") 
Debug.Print dataItems.Mean 

Answer 2

io uso un metodo di unire valori multipli in un unico .Item con un delimitatore raramente incontrato. Il .Item può essere diviso e avere i suoi elementi regolati mentre il dizionario è costruito.

Sub dictionaryCreate() 

    Dim rw As Long, vITM As Variant, vKEY As Variant 
    Dim d As New Dictionary ' or Object & CreateObject("Scripting.Dictionary") 

    d.CompareMode = vbTextCompare 

    With Worksheets("RAW_DATA") 
     For rw = 2 To 3000 'maybe this ~> .Cells(Rows.Count, 1).End(xlUp).Row 
      If d.Exists(.Cells(rw, 1).Value2) Then 
       vITM = Split(d.Item(.Cells(rw, 1).Value2), ChrW(8203)) 
       d.Item(.Cells(rw, 1).Value2) = _ 
        Join(Array(vITM(0) + .Cells(rw, 2).Value2, vITM(1) + 1), ChrW(8203)) 'modify and join on a zero-width space 
      Else 
       d.Add Key:=.Cells(rw, 1).Value2, _ 
         Item:=Join(Array(.Cells(rw, 2).Value2, 1), ChrW(8203)) 'join on a zero-width space 
      End If 
     Next rw 
    End With 

    Debug.Print "key" & Chr(9) & "sum" & Chr(9) & "count" 
    For Each vKEY In d.Keys 
     Debug.Print vKEY & Chr(9) & _ 
        Split(d.Item(vKEY), ChrW(8203))(0) & Chr(9) & _ 
        Split(d.Item(vKEY), ChrW(8203))(1) 
    Next vKEY 

    d.RemoveAll: Set d = Nothing 

End Sub 

I risultati finestra immediata del VBE:

key  sum count 
PersonA 100 2 
PersonB 57 2 
PersonC 13 1 

Answer 3

Utilizzando i dati di esempio e una classe

clsItem:

Public Sum As Double 
Public Count As Long 

Modulo:

Sub dictionaryCreate() 

    Dim Pair As Variant 
    Dim q As Range, v, k 
    Dim RAWDATA As Range 

    Dim d As Dictionary 
    Set d = New Dictionary 

    Set RAWDATA = [A2:A6] 
    For Each q In RAWDATA 
     Pair = q.Value 
     v = q.Offset(0, 1).Value 'get the value to be added... 
     If d.Exists(Pair) Then 
      d(Pair).Sum = d(Pair).Sum + v 
      d(Pair).Count = d(Pair).Count + 1 
     Else 
      d.Add Pair, NewItem(v) 
     End If 
    Next 

    'print out dictionary content 
    For Each k In d 
     Debug.Print k, d(k).Sum, d(k).Count 
    Next k 
End Sub 

Function NewItem(v) As clsItem 
    Dim rv As New clsItem 
    rv.Sum = v 
    rv.Count = 1 
    Set NewItem = rv 
End Function 

Answer 4

soluzione è simile a@Jeepedrisposta, ma ha qualche differenza.

Sub test() 
    Dim i, cl As Range, Dic As Object 
    Set Dic = CreateObject("Scripting.Dictionary") 
    Dic.CompareMode = vbTextCompare 
    For Each cl In Sheets("RAW_DATA").[A2:A6] 
     If Not Dic.Exists(cl.Value) Then 
      Dic.Add cl.Value, cl.Offset(, 1).Value2 & "|" & 1 
     Else 
      Dic(cl.Value) = Split(Dic(cl.Value), "|")(0) + cl.Offset(, 1).Value2 & _ 
         "|" & Split(Dic(cl.Value), "|")(1) + 1 
     End If 
    Next cl 
    Debug.Print "Key", "Sum", "Count" 
    For Each i In Dic 
     Debug.Print i, Split(Dic(i), "|")(0), Split(Dic(i), "|")(1) 
    Next i 
End Sub 

---

prova