Dict İle Veri Arama

[askm]

Kolay gelsin. A sütununda adı B sütununda soyadı ve sonraki 30 sütunda da veriler olan bir data sayfası mevcut. Bir de A sütununda sıra numarası ve sonrasında 10 sütunluk veri listesi olan Arama sayfası mevcut. Arama sayfasındaki 10 sütunluk veriyi Data sayfasında arama yapıyorum. Döngü ve find ile aratıyorum. Ama yavaş çalışıyor. Dictionary yöntemi ile daha hızlı arama yapabilir miyiz. Tek sütunda olsa yapılabilir. Ama bir taraf 30 sütun diğer taraf 10 sütun olunca dizine alamadım.
Kusura bakmayın şu anda örnek ekleyemiyorum.

 

[askm]

Veri Sayfasını Range("A1").CurrentRegion ile diziye alıyorum ama arama sayfası ile nasıl eşleştireceğim Sıra bozulmadan.

 

[Ziynettin]

Örnek dosyanız olmadan konu anlaşılmıyor ya da ben anlamadım.

 

[askm]

Örnek dosya ektedir. Anlatabildim mi bilemiyorum ama.

 

[Ziynettin]

Arama sayfası 2. satırdaki [B:K] koşullarına göre [L2] hücresine data sayfasına göre hangi satır numara yada numaralar gelmeli.

 

[askm]

Örneğin Arama sayfasındaki B2 hücresindeki veri, Data sayfasında hangi hücreye denk geliyor. Bunu bulursak yeterli olur aslında. B2 den K son satıra kadar bulduğunu L den itibaren yazabiliriz.

 

[ÖmerBey]

Merhaba,
Örnek dosyanız için aşağıdaki kodları dener misiniz?
Umarım isteğinizi doğru anlamışımdır.

Sub kod()
Set s = CreateObject("Scripting.Dictionary")
For Each hcr In Intersect(Sayfa1.Range("C2:ZZ1000000"), Sayfa1.UsedRange)
    If hcr <> "" Then
        If s.Exists(hcr.Value) Then
            s(hcr.Value) = s(hcr.Value) & vbLf & Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        Else
            s.Add hcr.Value, Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        End If
    End If
Next
dz = Sayfa2.Range("B2:K" & Sayfa2.Cells(Rows.Count, "B").End(3).Row)
For a = LBound(dz) To UBound(dz)
    For b = LBound(dz, 2) To UBound(dz, 2)
        If dz(a, b) <> "" Then
            dz(a, b) = s(dz(a, b))
        End If
    Next
Next
Sayfa2.Range("L2").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End Sub

 

[askm]

Çok teşekkür ederim.
Aşağıdaki şekilde hangi hücrelerden aldığını da yazdırmış oldu.

Sub kod()
Set s = CreateObject("Scripting.Dictionary")
For Each hcr In Intersect(Sayfa1.Range("C2:ZZ1000000"), Sayfa1.UsedRange)
    If hcr <> "" Then
        If s.Exists(hcr.Value) Then
            s(hcr.Value) = s(hcr.Value) & vbLf & hcr.Address & " " & Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        Else
            s.Add hcr.Value, hcr.Address & " " & Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        End If
    End If
Next
dz = Sayfa2.Range("B2:K" & Sayfa2.Cells(Rows.Count, "B").End(3).Row)
For a = LBound(dz) To UBound(dz)
    For b = LBound(dz, 2) To UBound(dz, 2)
        If dz(a, b) <> "" Then
            dz(a, b) = s(dz(a, b))
        End If
    Next
Next
Sayfa2.Range("L2").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End Sub

 

[askm]

Ömer Bey Aşağıdaki kısmı hızlandırmanın başka yolu var mıdır. Az veride hızlı çalışıyor ama 100 bin - 200bin satırda yavaşlıyor.

For Each hcr In Intersect(Sayfa1.Range("C2:ZZ1000000"), Sayfa1.UsedRange)
    If hcr <> "" Then
        If s.Exists(hcr.Value) Then
            s(hcr.Value) = s(hcr.Value) & vbLf & Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        Else
            s.Add hcr.Value, Sayfa1.Cells(hcr.Row, 1) & " " & Sayfa1.Cells(hcr.Row, 2)
        End If
    End If
Next

 

[ÖmerBey]

Bir de döngüyü For Each hcr In Intersect(Sayfa1.Range("C2:ZZ1000000"), Sayfa1.UsedRange).SpecialCells(xlCellTypeConstants) şeklinde değiştirip deneyiniz, boş hücreler döngüden çıkarılmış olur. Fakat şöyle de bir durum var: O kadar veride Dictionary limiti de aşılabilir.

 

[askm]

Peki farklı bir yol var mı? Bu arada araştırdığım sitelerde limitten hiç bahsetmiyordu. Limit olduğunu bilmiyordum.

 

[Trilenium]

Selamlar,

Şu 2 yere bakar mısın

https://stackoverflow.com/questions/1857404/excel-find-speed-vs-vba-binary-search

Fastest Search Excel VBA Codes – Aeternus Consulting Singapore

In this article I set myself a challenge to write the fastest VBA codes to locate a cell in a range of 5 column by 1048576 rows (5.2 millon cells) in a worksheet. They are written to be reusable in your own Excel VBA projects.

www.aeternusconsulting.com

Eğer işine yarayacak bilgiler yok ise

Google üzerinde excel speed search vba diye aratırsan işine yarayacak aramaları bulabilirsin.

 

[Korhan Ayhan]

Bu tarz veri yığınlarında en hızlı versiyon verileri diziye almaktır. Bu şekilde excel verilerinizi hafızaya yükleyerek rem (ram) performansından faydalanıyor. Bu da size ekstra hız kazandırıyor.

Bu konuyla ilgili forumda bolca örnek var. Biraz üzerine eğilirseniz çözersiniz.

 

[ÖmerBey]

Bu arada araştırdığım sitelerde limitten hiç bahsetmiyordu. Limit olduğunu bilmiyordum.

Haklısınız, ben yanılmışım.