Scripting.Dictionary nesnesi ile 3 sütunda benzersiz ve değerler toplamı

[Muhammet Okumuş]

Arkadaşlar merhaba,
Şu aralar Scripting.Dictionary nesnesini kavramaya çalışıyorum.
Sorumu formül veya diğer makrolarla çözebiliyorum.
Amacım sorumu Scripting.Dictionary ile çözmek hem de kod mantığını kavramaya çalışmak.
Scripting.Dictionary oldukça örnek mevcut ama tam kavrayamadığım için kendi sorunuma uyarlayamıyorum.
Kodun yapacağı işlem
A sütunundanki yılları F sütununa benzersiz listeleyecek.
G sütununa F sütunundaki yıl değerine göre B sütunundaki benzersiz turnuva adetlerini yazacak.
H sütununa da değerlerin toplamını bulacak.

 

 

[Muhammet Okumuş]

Murat Osma'nın sitesindeki dosyayı ve Korhan Bey'in yazmış olduğu kodu harmanlayarak sonuca ulaştım. Baya uğraştırdı ama. İşin güzel yanı
Scripting.Dictionary nesnesinin çalışma mantığını baya çözdüm sayılır.

Sub Emre()
Range("F:H") = ""
Dim dic As Object, liste(), dizi()
son = Cells(Rows.Count, "B").End(3).Row

liste = Range("A3:C" & son).Value
ReDim dizi(1 To son, 1 To 3)
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
For x = 1 To UBound(liste, 1)
aranan1 = liste(x, 1)
aranan2 = liste(x, 1) & liste(x, 2)

If Not dic1.exists(aranan1) Then

n = n + 1
m = m + 1
dic1.Add aranan1, n
dic2.Add aranan2, m
ReDim Preserve dizi(1 To son, 1 To 3)
dizi(n, 1) = liste(x, 1)
dizi(n, 2) = 1
dizi(n, 3) = liste(x, 3)

Else

If Not dic2.exists(aranan2) Then
m = m + 1
dic2.Add aranan2, m
ReDim Preserve dizi(1 To son, 1 To 3)

dizi(dic1.Item(aranan1), 2) = dizi(dic1.Item(aranan1), 2) + 1
dizi(dic1.Item(aranan1), 3) = dizi(dic1.Item(aranan1), 3) + 1
End If
End If


Next x

Range("F3").Resize(dic1.Count, 3) = dizi
Range("F3:H100").Sort Range("F3")

End Sub

https://www.excelarsivi.com/ adresinde kendinizi geliştirmek adına bir çok dosya bulunmakta. Tavsiye ederim.

 

[Korhan Ayhan]

Merhaba,

Sizin paylaştığınız kod istediğiniz sonucu verdi mi emin olamadım. Birde ekteki dosyayı deneyiniz.

 

[Muhammet Okumuş]

Adetler yakın 2005 benim kodun bulduğu sonuç doğru gibi. Sizde 10 bulmuş, bende 11. Sayı toplamları sizinki doğru. 2005 ve 2011 farklı

 

[Muhammet Okumuş]

Sub Emre()
Zaman = Timer
Range("F:H") = ""
Dim dic As Object, liste(), dizi()
Son = Cells(Rows.Count, "B").End(3).Row

liste = Range("A3:C" & Son).Value
ReDim dizi(1 To Son, 1 To 3)
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
For X = 1 To UBound(liste, 1)
aranan1 = liste(X, 1)
aranan2 = liste(X, 1) & liste(X, 2)

If Not dic1.exists(aranan1) Then

n = n + 1
m = m + 1
dic1.Add aranan1, n
dic2.Add aranan2, m
ReDim Preserve dizi(1 To Son, 1 To 3)
dizi(n, 1) = liste(X, 1)
dizi(n, 2) = 1


Else

If Not dic2.exists(aranan2) Then
m = m + 1
dic2.Add aranan2, m
ReDim Preserve dizi(1 To Son, 1 To 3)

dizi(dic1.Item(aranan1), 2) = dizi(dic1.Item(aranan1), 2) + 1

End If
End If


dizi(dic1.Item(aranan1), 3) = dizi(dic1.Item(aranan1), 3) + liste(X, 3)


Next X

Range("F3").Resize(dic1.Count, 3) = dizi
Range("F3:H100").Sort Range("F3")
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation

End Sub

Sub BENZERSİZ_ÇİFT_SÜTUN()
Dim s As Object, liste(), dizi()

Son = Cells(Rows.Count, "A").End(3).Row
liste = Range("A3:C" & Son).Value

ReDim dizi(1 To Son, 1 To 3)

Set s = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(liste, 1)
Aranan = liste(i, 1) & liste(i, 2)
If Not s.exists(Aranan) Then
Say = Say + 1
s.Add Aranan, Say

ReDim Preserve dizi(1 To Son, 1 To 3)
dizi(Say, 1) = liste(i, 1)
'dizi(say, 2) = dizi(say, 2) + liste(i, 2)
'dizi(say, 3) = dizi(say, 3) + liste(i, 2)
End If
Next i

Range("F3").Resize(s.Count, 3) = dizi
End Sub

Değer hesaplayan satırı koşul dışına çıkarınca hesaplamayı doğru yapıyor. Benim kodlar 0,05 sizinki 0,16 sn sürüyor.

 

[Muhammet Okumuş]

Korhan Bey değişken tanımlaması yapınca 0,04 saniyeye kadar indi. Sizin 2 defa döngüye almanız daha yavaş kalmasına neden olabilir mi?

 

[Korhan Ayhan]

Büyük ihtimalle öyledir...

 

[muratboz06]

Aşağıdaki örnek, konu hakkında size ışık tutabilir.

TabloOlusturScriptingDictionary.xlsm dosyasını indir - download

TabloOlusturScriptingDictionary.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[Muhammet Okumuş]

Aşağıdaki örnek, konu hakkında size ışık tutabilir.

TabloOlusturScriptingDictionary.xlsm dosyasını indir - download

TabloOlusturScriptingDictionary.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Cevabınız için teşekkür ederim. Kodları biraz inceledim. Geniş bir zamanda daha dikkatli inceleyeceğim. Yaklaşık 13 yıldır Excel ile sürekli uğraşıyorum ve her geçen gün kendime bir şeyler katıyorum.

Özellikle çok hızlı çalışan diziler ile ilgili çok geri kaldığımı söyleyebilirim. Bazen dolambaçlı yollarda da gitsem genel olarak kendi kendime yetiyorum.
Daha alacak çok yolum var.

 

[Korhan Ayhan]

Ekteki dosyada döngüyü teke düşürdüm. Bunun performansı biraz daha iyi gibi görünüyor.

Ben aslında tek Dictionary nesnesi kullanmanın daha hızlı olacağını düşünmüştüm. Ya kurduğum kurgu yavaş kaldı. Ya da birden fazla Dictionary kullanmak avantaj sağlıyor.

 

[Muhammet Okumuş]

Cevabınız için teşekkür ederim. Bir sorum olacaktı Scripting.Dictionary yönteminde minumum ve maksimum değerleri alabilir miyiz?

 

[Korhan Ayhan]

Neden olmasın...

Öğrenmek istiyorsanız bolca araştırma yapmanızı tavsiye ediyorum.

Dictionary object

Office VBA reference topic

docs.microsoft.com

VBA for smarties: Dictionaries

www.snb-vba.eu

Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery

This post contains everything you need to know about using the VBA Dictionary. There are tons of code examples including a real world application.

excelmacromastery.com

Excel VBA Dictionary Keys and Items - wellsr.com

Use a VBA dictionary to create a collection of key-item pairs in Excel. The VBA dictionary object links keys to items so you can get your items later by simply calling the key.

wellsr.com

VBA Dictionary

Excel VBA Dictionary Using VBA Dictionary, we can group all kinds of data in a dictionary to get access to all the items with a single variable. For

www.wallstreetmojo.com

VBA Dictionary

Guide to the definition of VBA Dictionary and Steps to create a Dictionary in Excel using VBA code along with downloadable excel template.

www.educba.com

Ayrıca görsel bir anlatımı da ekte bulabilirsiniz.

 

[Muhammet Okumuş]

Teşekkür ederim Korhan Bey, inceleyeceğim.

 

[Muhammet Okumuş]

Korhan Bey yazdığınız kodda

If Say > 0 Then
S1.Range("F3").Resize(Say, 3) = liste
S1.Range("F2").CurrentRegion.Sort S1.Range("F3"), xlAscending, , , , , , xlYes
End If

E sütununda da sıralama yapıyor. Sebebi ne acaba?

 

[Muhammet Okumuş]

Bir de yazdığım kodda
ReDim Preserve dizi(1 To son, 1 To 3) kısımını sildim ama sonuç aynı çıktı. Bu kısım gereksiz mi?

 

[Korhan Ayhan]

"E" sütunu boş değil mi?

 

[Muhammet Okumuş]

Boş ama E sütununda veri olsa ne yapacaktık? E sütunu sırlamaya neden dahil oluyor?

 

[Korhan Ayhan]

Kullandığım CurrentRegion komutu buna sebep oluyor.

Dilerseniz bunun yerine aşağıdaki satırı kullanabilirsiniz.

S1.Range("F3").Resize(Say, 3).Sort S1.Range("F3"), xlAscending, , , , , , xlNo