Dictionary

Ne, nasıl, nerede

Adı üzerinde, bu yapıları bir sözlük gibi kullanırız. Mesela çeşitli kategorideki kelimeler için Türkçe-İngilizce karşılıkları şeklinde bir liste oluşturabiliriz, veya bölge kodu-bölge adı gibi lookup listeleri oluşturabiliriz.

Key, Item
---- ----
bir, one
iki, two
.......

veya
5001, Akdeniz
5002, Başkent
.....

Diğer örnekleri şöyle sıralayabiliriz:

• Key:Ürün kodu, Item:ürün açıklaması(ürün yerine şube, bölge, stok v.s birçok şey konulabilir)
• Key:Ürün kodu, Item:ürün alış/satış fiyatı
• Key:Ürün kodu, Item:ürün cirosu/stok adedi v.s
• Key:Müşteri kodu, Item:Telefon no
• Key:Kısaltma, Item:Kısaltmanın uzun/açık hali(CHP, Cumhuriyet Halk Partisi gibi)
• vb.

Tanımlama şekilleri

Collectionlardan farklı olarak Dictionaryleri kullanmak için projemize Scripting.Runtime kütüphanesini(Library) eklemek gerekir. (Tools>References>Microsoft Scripting Runtime)

Dictionaryler, birçok object türü gibi hem Late hem Early binding şeklinde tanımlanabilirler. (Early ve Late binding hakkında detay bilgi ve birbirlerine göre avantaj/dezavantajları için buraya tıklayınız)

'Early binding olarak tanımlanırsa
Dim sayılar As New Scripting.Dictionary
'veya
Dim sayılar As Scripting.Dictionary
Set sayılar = New Scripting.Dictionary 

'Late binding olarak tanımlanırsa
Dim sayılar As Object
Set sayılar = CreateObject("Scripting.Dictionary")

Early Binding'in tek satır ve iki satır versiyonu arasındaki farkı Collectionlarda anlattığımız için burada tekrar aynı detaya girmiyorum.

Property ve Metodları

Eleman ekleme

Collectionlarda olduğu gibi eleman eklemek için Add metodu kullanılır. Dictionarylerde zorunlu olan iki parametre vardır, bunlar sırasıyla şöyledir: Key ve Item. (Collectionlarda Key opsiyoneldir)

Bunların ikisi de Variant tiptedirler, yani her değeri taşıyabilirler, buna Dictionary dahil, yani Dictionary Dictionary'si diye bir kavram teknik olarak mümkündür ve aşağıda da bir örneğini yapıyor olacağız. (Collectionlarda Key'ler string olmak zorundaydı)

Şimdi iki basit örnek yapalım, ilki sayıların Türkçe-İngilizce karşılığı, ikincisi de lookup liste olarak, bölge kodları ve bölge adları olsun.

Dim sayılar As New Scripting.Dictionary

sayılar.Add "bir", "one"
sayılar.Add "iki", "two"

Debug.Print sayılar("bir") 'one yazar

İkinci örneğimiz de şöyle:

Dim bölgeler As New Scripting.Dictionary

bölgeler.Add 5001, "Akdeniz"
bölgeler.Add 5002, "Başkent"

Debug.Print bölgeler(5001)

Key parametresi Collectionlarda olduğu gibi benzersiz bir parametre olmalıdır, yani sadece bir kere kullanılmalıdır. Collectionlarda vurgu Item'dadır, yani sözel ifade etmek gerekirse biz Item'ı depolarız ve ona istenirse Key adında bir isim veririz. Dictionarylerde ise vurgu Key'dedir, Key ile ona karşılık gelen yani onun lookup'ı olan Item birlikte depolanır.

Key de Item de Variant tipli parametrelerdir demiştik ancak Key'in bir istisnası var, dizi(array) olamaz. Item ise array dahil herşey olabilir.

Item propertysi/özelliği:Collectionlardan farklı olarak Dictionarylerde eleman eklemenin farklı bir yolu daha vardır: Doğrudan atama yöntemi(Implicit adding). Eğer Dictionary içinde olmayan bir anahtara atama yapılmaya çalışılırsa onu doğrudan eklemiş oluruz. Bunun için Item property'sini kullanırız, veya bu property düşürülerek de yazılabilir.

'madenler isimli dict içinde şuan sadece altın ve gümüş var olsun
madenler.Item("diamond")="elmas" 'madenler.Add "diamond", "elmas" ile aynı

Bu özellik, parametre olarak Key'i alır. Yani Key'i "diamond", Item'ı "elmas"tır. Mesela bu elemanda Item'ın baş harfini büyük olarak değiştirmek için şu kodu yazarız.

madenler.Item("diamond")="Elmas"
'veya kısaca
madenler("diamond")="Elmas"

Exists metodu ile "Varmı" kontrolü

Bir Key'in Dictionary'de olup olmadığını Exists metodu ile kontrol ederiz. Varsa True, yoksa False döndürür. Genel kullanımı "Eleman yoksa onu ekle" şeklindedir.

If Not dict.Exists("elma") Then dict.Add "elma", "apple"

Daha sadece olarak şöyle de diyebilirdik. Zira bu yöntemle, dictionary içinde "olmayan" bir elemanı doğrudan dictionary'ye ekliyorduk.

dict("elma")= "apple"

Ama "Varmı" kontrolünü yaptığımız sırada başka işlemler de yapmamız gerekirse Exists kullanmalıyız.

Collectionlarda doğrudan böyle bir metod yoktur. Bu işlem, hata kontrolü ile dolaylı olarak yapılmaktadır.

Items metodu

Bu metod, Dictionary içindeki tüm itemları döndürür ve bunu 0 tabanlı bir dizi olarak depolar.

meyveler=dict.Items 'elemanları diziye atadık
Debug.Print Join(meyveler,"-") 'dizideki elemanları - ile birleştirdik

Döngüyle tamamına erişebiliriz.

For Each i In dict.Items
  Debug.Print i
Next i

Debug.Print dict.Items(0)

Key propertysi

Dictionary içindeki belli bir Key'in değerini değiştirmek için kullanılır.(Key'in karşılık geldiği Item'ı değil. Bunun için Item özelliğini kullanıyoruz)

dict.Add "elma", "apple"
dict.Key("elma") = "Elma"

Bu yukardaki gibi bir örnekteki tekil bir elemanı değiştirmekten ziyade tüm Key'lerin önüne sabit bir ifade eklemek gibi çoklu değişiklikler yapılması daha olasıdır, ki bunu da döngü ile yaparız.

For Each k In dict.Keys
  dict.Key(k) = "M_" & k 'tüm meyvererin önünde Meyvenin M'si ve _ kodyduk
Next k

Elemanlara erişimi ve döngü detaylarını aşağıda göreceğiz.

Dikkat:Bu özellik Write-Only olup sadece Key'in değerini değiştirmek için kullanılır, Item'ı elde etmek için kullanılmaz. Item'ı elde etmek için nasıl kullanacağımıza elemanlara erişim bölümünden bakabilirsiniz.

Keys metodu

Dictionary içindeki tüm Keyleri döndürür ve bunu 0 tabanlı bir dizi olarak depolar.

meyveler=dict.Keys
Debug.Print Join(meyveler,"-")

Herhangi bir indeksteki Key'e ulaşmak için de kullanılır.

Debug.Print dict.Keys(0) 'kısaca dict(0) da yazılabilir

Remove ve RemoveAll ile eleman çıkarma

Belirtilen key'deki elemanı çıkarmak için Remove, tüm elamanları çıkarmak için yani Dictionary'yi boşaltmak için RemoveAll metodunu kullanırız.

meyveler.Remove "elma"
meyveler.RemoveAll

Collectionlarda RemoveAll yoktu, bunun yerine tüm Collection içinde dolaşıp elemanları tek tek kaldırmak gerekiyordu veya yeni Collection atama veya Nothing ataması yapmak gibi dolaylı yollara başvuruluyordu.

NOT:Nothing ataması veya New Dictionary ataması da ilgili dictionary'nin içini boşaltır.

Set meyveler = Nothing
Set meyveler = New Dictionary

CompareMode ile küçük/büyük harf duyarlılığı

Dictionaryler default olarak küçük/büyük harf ayrımına duyarlıdır(case-sensitive'dir), yani "elma" ve "Elma" farklı olarak algılanır. Bu duyarlılığı kaldırmak için aşağıdaki kod yazılır.

Dim dict As New Dictionary
dict.CompareMode = vbTextCompare 'veya numerik değer olarak 1

'tekrar case sensitive yapmak için şöyle yazılır
dict.CompareMode = vbBinaryCompare 'veya 0

Count ile eleman saymak

Collectiondaki gibi içerdeki toplam eleman sayısını verir.

Debug.Print dict.Count

Elemenlara tekil erişim ve Dictionary içinde dolaşma

Itemlara erişim ile Key'lere erişim bazen kafa karışıtırıcı olabilmektedir. Bu kısımda bunların detaylarına değinmeye çalışacağım.

Collectionlarda olduğunun aksine Dictionary'lere doğrudan Index numarası ile ulaşılmaz, zira Index diye birşey yoktur. Hatırlayacak olursak Collectionlar sıralı bir yapıya sahipken Dictionary'lerde sıra yoktur. Sonuç olarak, Dictionary'lerde elemanlara erişim onun Key'i aracalığı ile olur, bu da ya Indexli Key belirterek ya da doğrudan Key'in kendisi(Stringse) yazılarak olmaktadır. Indexli Key ile ulaştığımız şey Key'in kendisi iken, Key'in kendisini yazarak eriştiğimiz şey ise bu Key'in lookup değeridir. Collectionlarda Index ile Item'a ulaşıyorduk, ki buna Key adı verilerek de ulaşılabilir demiştik, Dictionarylerde ise Indexli key vererek Item'a ulaşıyoruz.

Dİkkat:Key ismini Key propertysi ile kullanamayız. Zira bu property write-only'dir, yani sadece Key'in değerini değiştirmek için kullanılır.

Farkındayım, bütün bunlar şuan çok karışık geliyor olabilir. Aşağıdaki örnekler biraz daha aydınlanmanıza yarayacaktır. Biraz aşağıda tüm bunları derleyip toplayan bir örnek ve bir tablo daha göreceksiniz. Ondan sonra kendi örneklerinizi de yapınca konu iyice pekişecektir.

Dim dict As New Dictionary
dict.Add "elma", "apple"

'Tekil elemana read erişimi
Debug.Print dict("elma") 'Key'in kendisi ile Itema erişim. apple değerini verir
Debug.Print dict.Keys(0) 'Indeksli Key ile Key'e erişim. elma değerini verir 
Debug.Print dict.Key("elma") 'Hata verir. Çünkü Key propertysi write-onlydir.

'Tekil elemanlara write erişimi
dict.Key("elma")="Elma" 'Key'in değeri değişti, onun lookupı olan Itemın değil. Yani elme Elme oldu.
dict("elma")="apple" 'Itemın değerini değişti. Eleman yoksa Implicit ekleme olur. Yani elma, apple ikilisi eklenir
dict.Item("apple")="Apple" 'Item'ın değerini değiştirdik.

Aşağıda ise erişim yöntemleriyle ilgili küçük bir collection/dictionary karşılaştırması bulunuyor.

Dim col As New Collection
Dim dict As New Scripting.Dictionary

'Collection örneği
col.Add "Elma" '1.index
col.Add "Armut" '2.index
col.Add "Erik" '3.index

Debug.Print col(2) 'veya col.Item(2). Armut yazar

'Key'li Coll örneği. ilk yazılan Item, ikincisi Key'dir
col.Add "Elma", "Apple"
col.Add "Armut", "Pear"
col.Add "Erik", "Plum"

Debug.Print col("Plum") 'Erik yazar
Debug.Print col("Erik") 'Hata verir. Erişim Item'la olmaz,

'Dictionary örneği. ilk yazılan Key, ikincisi Item'dır
dict.Add "Elma", "Apple"
dict.Add "Armut", "Pear"
dict.Add "Erik", "Plum"

Debug.Print dict("Armut") 'Pear yazar
Debug.Print dict.Key("Armut") 'Hata verir. Çünkü Key özelliği Write-Only

Tüm elemanları dolaşma

Dictionary'lerin tüm elemanları dolaşmak için tüm dizimsi yapılarda olduğu gibi For Next döngülerini kullanıyoruz.

For Each döngüsünü hem Early Binding hem Late Binding için kullanabilirken, For Next döngüsünü sadece Early Binding tanımlama yapıldığında kullanabilirz.(Binding çeşitleri hakkında bilgi için tıklayınız)

Dim k As Variant
For Each k In dict.Keys
   Debug.Print k, dict(k)
Next k

For Each k In dict.Keys satırını For Each k In dict şeklinde de yazabilirdik. Yani sadece Dictionary'nin adını yazmak onun Keys propertysine bakacağız diye algılanır. Collectionlarda böyle bi yazımla Items kastedilir.

Klasik For döngüsünde ise dikkat edilecek husus, başlangıcın 0'dan başlaması, bitiş indeksinin de eleman sayısı - 1 olmasıdır.

For i=0 To dict.Count-1
   Debug.Print dict.Keys(i), dict.Items(i)
Next i

Şimdi başka bir örneğe bakalım

Dim dict As New Scripting.Dictionary

dict.Add Key:="Apple", Item:="Elma"
dict.Add Key:="Orange", Item:="Portakal"
dict.Add Key:="Plum", Item:="Erik"

'Keylerin değerini değiştirebiliyoruz, yukardaki örnekte tek elemanın değerini 
'değiştirmiştik, şimdi tüm elemaların başına "A_" koyuyoruz.
For Each k In dict.Keys
   dict.Key(k) = "A_" & k
Next k

'tüm keyler ve bunların lookup değeri olan itemları yazdırıyoruz
For Each k In dict.Keys
   Debug.Print k, dict(k)
Next k

Şimdi bi de iki kolonlu bir listeyi döngüsel olarak Dictionary'ye ekleyelim, ama eklerken Varmı diye de kontrol edelim. Bu liste, Şube kodu ve şube adından oluşan bir liste olabilir.

Dim dict As Object 'Late binding ile yaratıyoruz
Set dict = CreateObject("Scripting.Dictionary")
 
Dim anahtar, deger 'tip belirtmeye gerek yok, Varianttırlar

Do
    anahtar = ActiveCell.Value
    deger = ActiveCell.Offset(0, 1).Value

    If Not dict.Exists(anahtar) Then
        dict.Add anahtar, deger
    End If
    
    ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell)

Debug.Print dict.Count

Key, Keys, Item ve Items birlikte kullanımı

Aşağıdaki iki örnek ile tüm bu öğrendiklerimizi pekiştirelim.

Sub foreach_in_dict()
Dim madenler As New Scripting.Dictionary

madenler.Add "gold", "altın"
madenler.Add "iron", "demir"
madenler.Item("diamond") = "elmas" 'madenler.Add "diamond", "elmas" ile aynı
madenler("cupper") = "bakır" 'üsttekinin kısa yöntemi

Debug.Print "--------sadece key---------"
For Each K In madenler.Keys 'Keys yazmasak da olur
    Debug.Print K
Next K

Debug.Print "--------sadece item---------"
For Each i In madenler.Items
    Debug.Print i
Next i

Debug.Print "------Keysden giderek ikili yazım----------"
For Each K In madenler.Keys
    Debug.Print K, madenler(K)
Next K

Debug.Print "--------Items'dan giderek ikili yazım olmaz---------"
For Each i In madenler.Items
    Debug.Print i, madenler.Item(i) 'Item belirterek key'lere ulaşılamaz
Next i

End Sub		
		

Bu örnek ise pekiştirme için çok daha kuvvetli bir örnek.

Sub key_değiştirme()
Dim iller As New Dictionary

iller.Add "01", "adana"
iller.Add "02", "adıyaman"
iller.Add "03", "afyon"

iller.Item(0) = "Adana" 'Key'i 0, Item'ı Adana olan yeni bir eleman ekler
iller.Item(0) = "İstanbul" 'Var olan bir kayıt olduğu için update yapar
iller.Items(0) = "hey" 'Items ile atama değil okuma yapılır, bu satır etkisizdir
Debug.Print iller.Item(0) 'Key'i 0 olan item okunur, yani İstanbul
Debug.Print iller.Items(0) 'Item indeksi 0 olan kayıt okunur

'iller.Key("06") = "Ankara" 'hata: olmayan bir key'e erişemeyiz
iller.Key("01") = "001" 'Key'in kendisini değiştirdik, write-only
iller.Keys(0) = "hey" 'item gibi etkisiz. keys sadece okumada kullanılr
Debug.Print iller.Keys(0) 'hey değil 001 yazar
'Debug.Print iller.Key(0) 'hata alrız, çünkü write-only

'şimdi baştan bir dolaşaım
Debug.Print "--------değişm öncesi------"
For Each K In iller.Keys
    Debug.Print K, iller(K)
Next K

'şimdi de hem keyleri hem itemları aynı anda değiştirelim
For Each K In iller.Keys
    YK = Val(K)
    iller.Key(K) = YK
    iller.Item(YK) = UCase(iller.Item(YK))
Next K

'şimdi dğeişklikleri kontrol edelim
Debug.Print "--------değişm sonrası------"
For Each K In iller.Keys
    Debug.Print K, iller(K)
Next K
End Sub	

Nihai Özet Tablo

Aşağıdaki tablo ile de yukarıdaki örnekleri bir tablo şeklinde görüyoruz.

İller isimli bir dictionary'miz olduğunu ve 01-Adana ile 33-İçel arasındaki kayıtların eklendiğini düşünün. Buna göre;

Collectionların ve Dictionarylerin karşılaştırılması

Bu iki yapının benzerlikleri, farklılıkları ve birbirine göre avantaj/dezavantajları bulunmaktadır. "Şu daha iyidir" diye doğrudan bir söylem doğru değildir. Her araçta olduğu gibi, o an ihtiyacımızı en iyi hangisi görüyorsa onu kullanmamız gerekmektedir. Ben burada bir karşılaştırma vereceğim, kararı siz verin. Tabiki benim de naçizane bazı tavsiye ve yönlendirmelerim olmayacak değil.

• Collectionlar VBA içinde yerel olarak bulunurken, Dictionary'leri kullanmak için bunu ya reference olarak eklemeli ya da CreateObject ile Late Binding şekilde yaratmalıyız.
• Dictioanry'lerde Key de Item da hem okunabilir hem yazılabilirdir. Ancak Collectionlarda Item'ın değerini değiştiremezsiniz, yani read-onlydir. Bunu yapmak için önce onu kaldırmalı sonra yeni değerle tekrar eklemeniz gerekir. Ayrıca Collectionlarda Keyler ne read-only ne write-onyldir, yani değer atanamadıkları gibi elde edilemezler de; sadece ilgili Item'a ulaşmada kullanılırlar.
• Collectionlar sıralıdır, Dictionarylerde sıra yoktur. Bu yüzden Collectionlar'a indeks numarası ile erişebilirken Dictionary'lerde indeks ile erişilemez. Bununla beraber Dictionary'lerin Keys ve Items metodları bunları 0 tabanlı bir dizi olarak döndürür, yani Key ve Item'lardan oluşan bir dizi 0 indekslidir. Ancak Collectionlarda indeks 1'den başlar.
• Her iki yapıda da elemanlarda dolaşmak için For Each yapısı kullanılır. Direkt ilgili nesnenin adı verilerek dolaşılmaya çalışıldığında, Collectionda itemlarda dolaşılırken Dictionarylerde Keylerde dolaşılır.
• Collectionları diziye atamak için döngüsel bir yapıyı içeren birkaç satırlık koda ihtiyaç duyulurken Dictionarylerde Items ve Keys metodları bize doğrudan dizi verirler.
• Dictionarylerde eleman eklemek için Add metoduna ek olarak implicit(üstü kapalı) ekleme yöntemi de varken, Collectionlarda yanlızca Add metodu kullanılır.
• Dictionarylerde tüm elemanlar tek seferde(RemoveAll ile) silinebilirken Collectionlarda dolaylı yöntemler izlenir.
• Keyler her ikisinde de benzersiz olmalıdır.
• Keyler Dictionaryde zorunlu iken Collectionda seçimliktir.
• Keyler Collectionlarda String olmalıyken, Dictionarylerde ise dizi dışında herşey olabilirler.
• Dictionarylerde bir elamanın var olup olmadığı Exists metodu ile kontrol edilebilirken Collectionlarda bu kontrol için birkaç satırlık kod yazmak gerekir.
• Collectionlar küçük/büyük harf ayrımına duyarlı değilken Dictionaryler duyarlıdır, istenirse duyarsız hale getirilebilir.
• Genel olarak bakıldığında, Dictionaryler Collectionlara göre daha hızlıdır

Bu farkları bir kısmını küçük bir kodda inceleyelim:

Sub coll_vs_dict()
Dim dict As New Dictionary 'library
Dim coll As New Collection 'no library

dict.Add "yüz", "hundred"
coll.Add "hundred", "yüz"

Debug.Print dict.Keys(0), dict.Items(0) 'iki değer de elde edilebilir
Debug.Print coll(1), coll("yüz") 'Key yani "yüz" değeri elde edilemez

dict.Item("yüz") = 100 'key'in lookup değeri olan item'ı değiştirebiliriz
Debug.Print dict.Keys(0), dict.Items(0)
coll(1) = 100 'hata. collectionlar readonlydir, itemlar dğeiştirilemez, keylere zaten ulaşamıyoruz bile

Debug.Print dict(0) 'dictionaryde indeks yoktur
Debug.Print coll(1) 'collectionlarda indeks var ve 1'den başlar
End Sub

Büyük üstat Cpearson der ki:

Her iki obje de benzer datayı gruplamak için çok faydalıdır ancak herşey eşit olduğunda ben Dictionary kullanmayı tercih ederim.

Gerekçe olarak da yukarda belirttiğim maddelerden bazılarını dile getirmiş.

Benim de naçizane bir tavsiyem var: Eğer sadece arka arkaya birşeyler eklemek istiyorsanız ve kümeden birşeyler çıkarma veya Varmı kontrolü gibi şeyler yapmayacaksanız Collection kullanın, hem de Key'siz haliyle. Ama bir lookup değeri de olacaksa Key ve Item ikilisine yani bir Dictionary'ye ihtiyacınız var demektir.

İçiçe Dictionary(Dictionary of Dictionary)

Dizi Dizisi ve Collection Collectionı gibi Dictionarylerin de içiçe geçmiş formları vardır. Hatta yeri gelir, Dictionary of Collection, Collection of Dictionary veye Array of Collection gibi çapraz formlar da kullanmamız gerekebilir.

Benim şahsen çok ihtiyacım olmadı ancak internette bol miktarda örnek bulunmaktadır. Mesela şu sayfada hem Dictionaryler hakkında çok faydalı bilgiler hem de içiçe Dictionary dahil birçok örneği bulabilirsiniz.

Bununla birlikte gözünüzde canlanması için aşağıdaki gibi bir örnek kod yazabiliriz.

Sub dictofdict()
Dim m As New Scripting.Dictionary
Dim s As New Scripting.Dictionary
Dim dict As New Scripting.Dictionary

m.Add "elma", "apple"
m.Add "erik", "plum"

s.Add "salatalık", "cucumber"
s.Add "domates", "tomato"

dict.Add "meyveler", m
dict.Add "sebzeler", s

Debug.Print dict("meyveler")("elma") 'veya dict("meyveler").Item("elma")

End Sub

Bu arada  ilk başta kulağa sanki Dictionary of Dictionary ile çözülebilirmiş gibi gelen bir problemi ben aşağıdaki gibi Dicitonary ve 3 boyutlu dizi ile hallettim. Biraz üzerine düşününce farklı çözümler de üretilebiliyor. Mesela listenizi farklı bir formata getirip arkasından Dictionary tipli bir dizi ile de sorun çözülebilir.

Sub dictvedizi()
Dim Blg As New Scripting.Dictionary
Dim Sgm As New Scripting.Dictionary
Dim Siciller() As String

ReDim Siciller(0 To 2, 0 To 3, 0 To 3) 'boyutlar sırayla şöyle:bölge sayısı, segment  sayısı, kişi sayısı

Set alanBolge = Range(Range("a2"), Range("a2").End(xlDown))
Set alanSegment = Range(Range("c2"), Range("c2").End(xlDown))

i = 0
For Each d In alanBolge
    If Not Blg.Exists(d.Value) Then
        Blg.Add Key:=d.Value, Item:=i
        i = i + 1
    End If
Next d

k = 0
For Each d In alanSegment
    If Not Sgm.Exists(d.Value) Then
        Sgm.Add Key:=d.Value, Item:=k
        k = k + 1
    End If
Next d

'data okuma
For Each d In alanBolge
    Siciller(Blg(d.Value), Sgm(d.Offset(0, 2).Value), dolusay(Siciller, Blg(d.Value), Sgm(d.Offset(0, 2).Value)) + 1) = d.Offset(0, 1).Value
Next d

'hedefe yazma
For i = 0 To Blg.Count - 1
    Cells(i + 2, 5).Value = Blg.Keys(i)
Next i

For i = 0 To Sgm.Count - 1
    Cells(1, i + 6).Value = Sgm.Keys(i)
Next i


For x = 1 To 4
    For y = 1 To 3
        Set h = Cells(1 + y, 5 + x)
        h.Select
        h.Value = sonucgetir(Siciller, Blg(h.Offset(0, -x).Value), Sgm(h.Offset(-y, 0).Value))
    Next y
Next x


End Sub
Public Function dolusay(ByVal Data As Variant, ByVal i1 As Integer, ByVal i2 As Integer) As Integer
    Dim Count As Integer
    Count = 0
    
    For j = 0 To UBound(Data, 3) - 1
        If Len(Data(i1, i2, j)) > 0 Then
            Count = Count + 1
        End If
    Next j
    dolusay = Count
End Function
Public Function sonucgetir(ByVal Data As Variant, ByVal i1 As Integer, ByVal i2 As Integer) As String
    sonucgetir = ""
    For i = 0 To UBound(Data, 3)
        If Len(Data(i1, i2, i)) > 0 Then
            x = Data(i1, i2, i) & ";" & x
            sonucgetir = Left(x, Len(x) - 1)
        End If
    Next i
End Function

Kodu biraz inceleyin, başka türlü nasıl yapılabilrdi, onu düşünün. Şükür ki, gerek Excel'de gerek VBA'de bir işi yapmanın birden çok yolu olabilmektedir. Artık aklınıza hangisi gelirse onun üzerine yoğunlaşın.

Her değer için min/maks değeri alıp depolama

			Sub enbuyuktarih()
			Dim st As New Scripting.Dictionary
			Dim alan As Range, a As Range
			
			Set alan = Range("A2:A7")
			For Each a In alan
			    If Not st.Exists(a.Value2) Then
			        st.Add a.Value2, a.Offset(0, 2).Value
			    End If
			Next a
			
			For Each s In st
			    Debug.Print s, st(s)
			Next s
			End Sub	

			Sub enbuyuktarih2()
			Dim st As New Scripting.Dictionary
			Dim col As New Collection
			Dim alan As Range, a As Range
			
			Set alan = Range("A2:A7")
			For Each a In alan
			    If Not st.Exists(a.Value2) Then
			        st.Add a.Value2, a.Offset(0, 2).Value
			        col.Add a.Offset(0, 1).Value, CStr(a.Value) 'Keyler collectionlarda  string olmalı
			    End If
			Next a
			
			For Each s In st
			    Debug.Print s, st(s), col(CStr(s))
			Next s
			End Sub	
				
				

Dictionary tipli bir dizi

				Sub arraydict()
				Dim dict(2) As New Scripting.Dictionary
				dict(0).Add "ekmek", "bread" 'ingilizce
				dict(1).Add "ekmek", "brot" 'almanca
				dict(2).Add "ekmek", "brotti" 'italyanca
				'1000 satır boyunca 1000 kelimeyi okuyup atadık diyelim
				
				'almancada ekmek ne demek
				Debug.Print dict(1)("ekmek")
				End Sub

				Sub arraydict2()
				Dim dict(1) As New Scripting.Dictionary
				Dim alan As Range, a As Range
				
				Set alan = Range("A2:A7")
				For Each a In alan
				  If Not dict(0).Exists(a.Value2) Then 'herhangi birine bakılabilir
				    dict(0).Add a.Value, a.Offset(0, 1).Value 'şb
				    dict(1).Add a.Value, a.Offset(0, 2).Value 'tarih
				  End If
				Next a
				
				For Each s In dict(0)
				    Debug.Print s, dict(0)(s), dict(1)(s)
				Next s
				
				End Sub
				

Dictionary, Collection ve Collection Dizisi bir arada

Sub mukerrerbul()

Dim dict As Object
Dim koll As New Collection
Dim babaKol() As Collection
Dim a As Range, s As Range
Dim i As Integer
Dim c As Variant

'babaKol collection dizisinin boyutunu buluyoruz
For Each a In Range([e2], [e2].End(xlDown))
    If Not ColdaVarmı(koll, a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value) Then
        koll.Add a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value
    End If
Next a

Set dict = CreateObject("Scripting.Dictionary")
'önce g'nin boyutunu berlieyelim
ReDim babaKol(koll.Count - 1)

'sonra dolu olan alımları dictionary'ye ekliyoruz
For Each a In Range([e2], [e2].End(xlDown))
    If Not dict.Exists(a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value) And Not IsEmpty(a.Offset(0, 2)) Then
        Set babaKol(i) = New Collection
        dict.Add a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value, babaKol(i)
        babaKol(i).Add a.Row
        i = i + 1
    ElseIf dict.Exists(a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value) And Not IsEmpty(a.Offset(0, 2)) Then
        dict(a.Value & a.Offset(0, 2).Value & a.Offset(0, 6).Value).Add a.Row
    End If
Next a

'şimdi satımları kontrol ediyruz. varsa, hem bunu hem de bunun alım karşılığını işaretliyoruz
For Each s In Range([e2], [e2].End(xlDown))
    If dict.Exists(s.Value & s.Offset(0, 4).Value & s.Offset(0, 6).Value) Then
        'önce satımı boyayalım
        s.EntireRow.Font.Color = vbRed
        'şimdi de alımları boyayalım
        For Each c In dict(s.Value & s.Offset(0, 4).Value & s.Offset(0, 6).Value)
            Rows(c).Font.Color = vbRed
        Next c
    End If
Next s

End Sub
Function ColdaVarmı(col As Collection, kontrol As Variant) As Boolean
    On Error Resume Next
    ColdaVarmı = False
    Dim x As Variant
    For Each x In col
        If x = kontrol Then
            ColdaVarmı = True
            Exit Function
        End If
    Next x
End Function