Scripting Dictionary ile Vlookup kullanımı

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Scripting Dictionary ile Vlookup kullanımı

İleti#1)  muratvural » 21 May 2020 21:08

Arkadaşlar Merhaba,

Google'da araştırma yaparken, bir sitede aşağıdaki gibi bir kod buldum (Milyon satır veri de olsa, çok hızlı çalışan bir vlookup kodu).

Anlamaya çalıştım ancak biraz karışık geldi. Hani, bir data olur, başka yerde de karşılaştırılacak bir veri olur.

Burada karşılaştırma nerede yapılıyor, eşleşecek kayıt bulunduğunda istenilen sütunlar nerede belirtiliyor vs.

Nasıl kullanacağımı anlamak için soruyorum, rica etsem yanlarına nasıl çalıştığı ile ilgili açıklama yazabilir misiniz?

Kod: Tümünü seç
Dim S1 As Worksheet, s2 As Worksheet
Dim dic As Object, i As Long
Dim a(), b(), c()

t = TimeValue(Now)

Set S1 = Sheets("Data")
Set s2 = Sheets("LOOKUP")

Set dic = CreateObject("scripting.dictionary")
Set dic1 = CreateObject("scripting.dictionary")

a = S1.Range("A2:E" & S1.Cells(Rows.Count, 1).End(3).Row).Value
b = s2.Range("A2:A" & s2.Cells(Rows.Count, 1).End(3).Row).Value

   For i = 1 To UBound(b)
        dic(b(i, 1)) = b(i, 1)
    Next i

    ReDim c(1 To UBound(b), 1 To 4)

    For i = 1 To UBound(a)
        If dic.exists(a(i, 1)) Then
            dic1(a(i, 1)) = i
        End If
    Next i

    For i = 1 To UBound(b)
        For j = 1 To 4
            c(i, j) = a(dic1(b(i, 1)), j + 1)
        Next j
    Next i

s2.Range("K2:N" & s2.Cells(Rows.Count, "K").End(3).Row) = ""
s2.[K2].Resize(UBound(b), 4) = c

MsgBox CDate(TimeValue(Now) - t), vbInformation

Kullanıcı avatarı
muratvural
Siteye Alışmış
 
Adı Soyadı:Murat Vural
Kayıt: 09 Mar 2010 23:45
Konum: türkiye
Meslek: istatistik
Yaş: 41
İleti: 144
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#2)  gicimi » 25 May 2020 00:05

Merhaba;

Kod: Tümünü seç
     Makro içinde kullanılacak tanımlamalar yapılıyor.
    Dim S1 As Worksheet, S2 As Worksheet
    Dim dic As Object, dic1 As Object, i As Long
    Dim a(), b(), c()
   
     Makronun çalışma süresini hesaplamak için başlama zamanı belirleniyor.
    t = TimeValue(Now)
   
     Sayfalar değişkene atanıyor.
    Set S1 = Sheets("Data")
    Set S2 = Sheets("LOOKUP")
   
     Verilerin hafızaya alınması için Dictionary nesneleri tanımlanıyor.
    Set dic = CreateObject("scripting.dictionary")
    Set dic1 = CreateObject("scripting.dictionary")
   
     DATA sayfasındaki A-E sütun aralığındaki veriler "a" dizisine yükleniyor.
    a = S1.Range("A2:E" & S1.Cells(Rows.Count, 1).End(3).Row).Value
   
     LOOKUP sayfasındaki A sütunundaki veriler "b" dizisine yükleniyor.
    b = S2.Range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row).Value
   
     LOOKUP sayfasındaki A sütunundaki veriler "dic" nesnesine benzersiz yükleniyor.dizisine yükleniyor.
    For i = 1 To UBound(b)
        dic(b(i, 1)) = b(i, 1)
    Next i
   
     "c" dizisi tanımlanıyor. LOOKUP sayfasındaki A sütunundaki benzersiz veri sayısı kadar satır ve 4 sütundan oluşan bir dizidir.
    ReDim c(1 To UBound(b), 1 To 4)
   
     "a" dizisine yüklenen veriler döngüye alınıyor.
     Döngüye alınan verilerin tem tek "dic" nesnesine yüklenen benzersiz veriler arasında varsa bu sefer "dic1" nesnesine benzersiz KEY ile yükleniyor.
     Buradaki KEY "i" değeridir.
    For i = 1 To UBound(a)
        If dic.exists(a(i, 1)) Then
            dic1(a(i, 1)) = i
        End If
    Next i
   
     "b" dizisine yüklenen veriler tekrar döngüye alınıyor. Bu aşamada daha önce tanımlanan "c" dizine sonuç verileri yükleniyor.
     Bu döngüde "i" değeri bizim bir önceki döngüde KEY diye tanımlanan değerdir. Bu KEY değerine göre "a" dizisindeki veriler "c" dizisine yükleniyor.
    For i = 1 To UBound(b)
        For j = 1 To 4
            c(i, j) = a(dic1(b(i, 1)), j + 1)
        Next j
    Next i
   
     Oluşan sonucun sayfaya aktarılması için K-N sütun aralığı temizleniyor.
    S2.Range("K2:N" & S2.Cells(Rows.Count, "K").End(3).Row) = ""
   
     Oluşan sonuç dizisinin satır sayısı ve 4 sütun genişlinde yani K-N sütun aralığına yazdırılıyor.
    S2.[K2].Resize(UBound(b), 4) = c
   
     Kullanıcıya işlemin ne kadar sürdüğü ile ilgili bilgilendirme mesajı veriliyor.
    MsgBox CDate(TimeValue(Now) - t), vbInformation
Kullanıcı avatarı
gicimi
Yeni Başlamış
 
Kayıt: 28 Arl 2014 02:06
Meslek: teknisyen
Yaş: 32
İleti: 55
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#3)  gicimi » 25 May 2020 23:49

Alternatif,
Aşağıdaki yapı ise 3-4 saniye civarında sonuç veriyor.

Kod: Tümünü seç
Option Explicit

Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Veri_Tablosu As Variant, Aranan_Veri As Variant
    Dim X As Long, Son As Long, Y As Long, Say As Long
    Dim Kontrol As Boolean, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("Data")
    Set S2 = Sheets("LOOKUP")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri_Tablosu = S1.Range("A2:E" & Son).Value
   
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    Aranan_Veri = S2.Range("A2:A" & Son).Value
   
    ReDim Liste(1 To UBound(Aranan_Veri), 1 To 4)
   
    For X = LBound(Aranan_Veri) To UBound(Aranan_Veri)
        Kontrol = False
        For Y = LBound(Veri_Tablosu) To UBound(Veri_Tablosu)
            If Aranan_Veri(X, 1) = Veri_Tablosu(Y, 1) Then
                Say = Say + 1
                Liste(Say, 1) = Veri_Tablosu(Y, 2)
                Liste(Say, 2) = Veri_Tablosu(Y, 3)
                Liste(Say, 3) = Veri_Tablosu(Y, 4)
                Liste(Say, 4) = Veri_Tablosu(Y, 5)
                Kontrol = True
                Exit For
            End If
            If Say = UBound(Liste, 1) Then GoTo 10
        Next
        If Kontrol = False Then
            Say = Say + 1
            Liste(Say, 1) = "Yok"
            Liste(Say, 2) = "Yok"
            Liste(Say, 3) = "Yok"
            Liste(Say, 4) = "Yok"
        End If
    Next
   
10  If Say > 0 Then
        S2.Range("K:N").ClearContents
        S2.Range("K2").Resize(Say, 4) = Liste
    End If
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Kullanıcı avatarı
gicimi
Yeni Başlamış
 
Kayıt: 28 Arl 2014 02:06
Meslek: teknisyen
Yaş: 32
İleti: 55
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#4)  korhan ayhan » 26 May 2020 12:40

Sn. @gicimi,

Paylaşımınız için teşekkürler.

Not: Kaynak belirtmeniz daha şık olurdu.
Kullanıcı avatarı
korhan ayhan
Siteye Alışmış
 
Adı Soyadı:Korhan AYHAN
Kayıt: 26 Ağu 2008 22:04
Konum: ANTALYA
Meslek: TURİZM-MALİYET MUHASEBESİ
Yaş: 47
İleti: 187
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#5)  muratvural » 26 May 2020 15:50

Korhan Bey ve (Sn.Gecimi, konuyu farklı mecralarda araştırıp döndüğünüz için) ikinize de ayrı ayrı teşekkür ediyorum.

Aslında yapmak istediğim şöyleydi;

Veri olan sayfada ilk 2 sütundaki değerleri (ID ve ismi), yani tekrarlayan değerleri,

İkinci bir sayfaya ID ve ismi benzersiz şekilde alıp, yanlarına da belirlediğim sütunlardaki değerlerin gelmesini istiyorum.

Uzun yoldan kayıtların teke düşürülmesi ve vlookup kullanımı ile yapabilirim.

Ancak, Collection ve Scripting Dictionary'ler bir çok koda göre çok hızlı çalıştığı için,

buradaki yapıyı anlayıp hep onu kullanmak istemiştim (Şu an ve ilerde, genel anlamda hız ve zaman tasarrufu kazanmak adına).

Tabi, burada benzer ve benzersiz kayıtlar için nasıl kullanacağımı anlayamadım.

Ancak, şu an yapmak istediğim görsel olarak buydu;

Sayfa1
111 | Ali | n |
111 | Ali | n |
222 | Elif | n |
222 | Elif | n |
222 | Elif | n |
-------------
Sayfa2
111 | Ali | n
222 | Elif| n
Kullanıcı avatarı
muratvural
Siteye Alışmış
 
Adı Soyadı:Murat Vural
Kayıt: 09 Mar 2010 23:45
Konum: türkiye
Meslek: istatistik
Yaş: 41
İleti: 144
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#6)  gicimi » 28 May 2020 20:08

@korhan Hocam Merhaba;

Code bölümüne https://www.excel.web.tr/threads/scripting-dictionary-ile-vlookup-kullanimi.188214/#post-1042741
URL eklemiştim ama gözükmüyor. Kusura bakmayın.
Kullanıcı avatarı
gicimi
Yeni Başlamış
 
Kayıt: 28 Arl 2014 02:06
Meslek: teknisyen
Yaş: 32
İleti: 55
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ankara

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Scripting Dictionary ile Vlookup kullanımı

İleti#7)  korhan ayhan » 30 May 2020 01:09

Bu durumda örnek dosya paylaşarak hangi sütunu almak istediğinizi belirtirseniz daha iyi yardımcı olabiliriz.
Kullanıcı avatarı
korhan ayhan
Siteye Alışmış
 
Adı Soyadı:Korhan AYHAN
Kayıt: 26 Ağu 2008 22:04
Konum: ANTALYA
Meslek: TURİZM-MALİYET MUHASEBESİ
Yaş: 47
İleti: 187
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ANTALYA


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 3 misafir

Bumerang - Yazarkafe