Scripting.Dictionary

Function zbierajdane() As scripting.dictionary

Application.ScreenUpdating = False
Dim d As New Scripting.Dictionary
Dim vArray As Variant
For Each c In Sheets("sheet35").Range("inandout").Columns(5).Cells
If d.Exists(c.Value) Then
Set d(c.Value) = d(c.Value) + 1 'jeżeli już istnieje taki klucz w słowniku, to dodaję +1, w ten sposób wiem ile jest takich samych kluczy w danym zakresie
Else: d.Add c.Value, "1"
End If
Next
zbierajdane = d

End Function


Sub słowniczek
Dim d As scripting.dictionary

Set d = zbierajdane

If Not d Is Nothing Then
For i = 0 To d.Count - 1
debug.print d.Items(i), d.keys(i)
Next i

End If

End Sub

'słownikczek do tej subrytyny zbudowany był tak,
'że pętla przez pewien zakres zbierała informacje ile razy dana osoba pojawia się jako
'odpowiedzialna za daną rzecz(ile razy nazwisko pojawiało się w kolumnie, tyle razy coś się działo)

Sub pętlaPrzezKlucze(d As Scripting.Dictionary)

Dim k As Long
Dim os As Variant

k = d.Count - 1 'tyle jest unikatowych kluczy (właściwie kazdy klucz musi być inikatowy, więc tyle jest kluczy ogółem, bo 0 to pierwszy klucz :))

os = d.Keys()(k) ' w moim przypadku kluczami były nazwiska, dlatego zmienna "OS"
'q = d.Item(k)
Do
If d.Items()(k) = 0 Then
d.Remove d.Keys(k)
k = k - 1
os = d.Keys(k)
End If
'tu coś się działo, a potem ilość spraw dla danej osoby była redukowana o 1, poniższym kodem
Set d.Item(d.Keys(k)) = d.Item(d.Keys(k)) - 1
Loop Until k = 0 'zapętlamy dopóki nie pozbędziemy się wszystkich osób i ich spraw

End Sub