Dict İle Veri Arama

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Veri Sayfasını Range("A1").CurrentRegion ile diziye alıyorum ama arama sayfası ile nasıl eşleştireceğim Sıra bozulmadan.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Örnek dosyanız olmadan konu anlaşılmıyor ya da ben anlamadım.
 

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Örnek dosya ektedir. Anlatabildim mi bilemiyorum ama.
 

Ekli dosyalar

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Ö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

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Örnek dosyanız için aşağıdaki kodları dener misiniz?
Umarım isteğinizi doğru anlamışımdır.
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Çok teşekkür ederim.
Aşağıdaki şekilde hangi hücrelerden aldığını da yazdırmış oldu.
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Ö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.
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Peki farklı bir yol var mı? Bu arada araştırdığım sitelerde limitten hiç bahsetmiyordu. Limit olduğunu bilmiyordum.
 

Trilenium

Destek Ekibi
Destek Ekibi
Katılım
16 Eylül 2008
Mesajlar
1,054
Excel Vers. ve Dili
Microsoft Office 2019 English
Selamlar,

Şu 2 yere bakar mısın



Eğer işine yarayacak bilgiler yok ise

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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,328
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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.
 
Üst