• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

VBA ile En Hızlı Vlookup Yapma konusunda yardım

T

toybuklu

Katılım
22 Ekim 2009
Mesajlar
151
Excel Vers. ve Dili
2007&2010
Merhaba Üstadlarım;

Ekteki dosyadam 2 sheetim var data sheetindeki barkodların statüler sheetinde eşleşenlerin yanında yazan statü1 ve statü2 lerin data sheetine yanlarına yazdırılması için Hızlı bir eşleştirme yöntemi arıyorum bu konuda yardımlarınızı rica ediyorum. Ekteki dosya örnektir asıl kayıt sayım 100.000 kadardır.
Normal Vlookup yöntemiyle yaklaşık 20 dan fazla sürüyor eşleştirme.
Çünkü her barkodu 100.000 barkodda aramasından dolayı.
Şöyle bişey yapan biri görmüştüm 2 listeninde sortlanmış olduğunu düşündük sonrasında datadaki ilk kaydı ilk 1-10 içinde arıyor bulamaz ise 11-1000 arasında arıyor bulmazsa 1001-10000 arasında arıyor bu toplam kayıt sayısı kadar devam ediyor ve arama daha hızlı bir şekilde devam ediyor.Son olarak eşleşmeyi bulduğu anda sonraki kayda geçmeli kaydı bulup diğer kayıtlarla kontrol yapmasın bulduğu yerde sonuçları yazıp sonraki kayda geçsin..

bu bahsettiğim yapıda yada bilinen en hızlı eşleştirme yolu konusunda derin bilgilerinizden faydalanmak istiyorum lütfen ilgi ve alakanızı eksik etmeyin

Saygılarımla...
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu deneyin. Veri sayınızın çok olması nedeniyle yine de yavaş çalışabilir. Deneyerek süreyi bildirirseniz memnun olurum.

Kod: 
Sub statugetir()
For a = 2 To [data!a65536].End(3).Row
say = WorksheetFunction.CountIf([statüler!a:a], Sheets("data").Cells(a, "a"))
If say > 0 Then
sat = WorksheetFunction.Match(Sheets("data").Cells(a, "a"), [statüler!a:a], 0)
Sheets("data").Cells(a, "c") = Sheets("statüler").Cells(sat, "c")
Sheets("data").Cells(a, "d") = Sheets("statüler").Cells(sat, "d")
End If
Next
End Sub
 
Merhaba,

Levent Bey sizin önerdiğiniz kodu 100000 satırda denedim. Yaklaşık 70 saniyede işlemi tamamlıyor. Aşağıdaki kod ile işlem 38 saniye sürdü.

Kod: 
Sub HIZLI_ARA()
    Dim Zaman As Double, X As Long, BUL As Range
    Dim S1 As Worksheet, S2 As Worksheet, Alan As Range
    
    Zaman = Timer
    
    Set S1 = Sheets("Data")
    Set S2 = Sheets("Statüler")
    Set Alan = S2.Range("A2:A1048576")
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        Set BUL = Alan.Find(S1.Cells(X, 1), , , xlWhole)
        If Not BUL Is Nothing Then
            S1.Cells(X, 3) = BUL.Offset(, 2)
            S1.Cells(X, 4) = BUL.Offset(, 3)
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbInformation
End Sub
 
Kısaca kodun yaptığı nedir hocam. kodu çalıştırdım bekliyorum
 
Bendemi bir sıkıntı var acaba hala çalışıor 10 dk oldu ? levent beyin koduyla.
 
Verdiğim sonuçlar İ7 işlemcili 64 Bit sisteme aittir. Donanıma göre performans değişecektir.
 
Ben bu tip işlemlerde SQL (query table) kullanıyorum. Az önce bir test yaptım; yaklaşık işlem süresi 1 sn. kadar. Dosyanızı az sonra ekleyeceğim...
 
İ3 64 Bit 6 GB ram sistemde çalıştırıyorum sizin kodu da deniyorum hocam şuanda
 
Mesajınızı okuduktan sonra örnek dosyanızdaki "Statüler" sayfasındaki kayıt sayısını 100 bin adede çıkarttım. "Data" sayfasına hiç dokunmadım. Bu haliyle önerdiğim kod 1,38 saniyede işlemi tamamlıyor.

Not: Zeki bey son noktayı koymuş...
 
530 saniye sürdü Korhan Hocam .. Levent Hocam Korhan Hocam İlginize teşşkürler. Zeki hocam sizin bahsettiğiniz dosyayıda bekliyorum.. Tşk.

Benim çalışmamda data ve statüler sheetlerinde 100 er bin kayıt var..
 
Her iki sayfayıda 100 bin kayıt olarak çoğalttım ve işlem 129 saniye sürdü.
 
Korhan bey yanlış anlamayın desteğiniz için teşekkürler zeki beyin önerisi benim için uygun olmaz ise sizin kodu kollanacağım ama levent beyin kodunuda yedeğimde tutacağım çok teşekkürler..
 
Dosya ektedir. İki seçiminiz var:

- Query table,
- ADO

100.000 kayıttaki sonucu ben de merak ediyorum.

Kod: 
Sub test()
c = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};dbq=" & ThisWorkbook.FullName

q = "SELECT `Data$`.Barkod, `Data$`.`tarih `, `Statüler$`.`Statü 1`, `Statüler$`.`Statü 2` " & _
    "FROM `Data$` `Data$`, `Statüler$` `Statüler$` " & _
    "WHERE `Data$`.Barkod = `Statüler$`.Barkod order by 1"

Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

cn.Open c

t = Timer

rs.Open q, cn

Set sh = Worksheets.Add
sh.Name = "Rapor_" & Sheets.Count - 1

For i = 0 To rs.Fields.Count - 1
    sh.Cells(1, i + 1) = rs(i).Name
Next

sh.[a2].CopyFromRecordset rs

rs.Close
cn.Close

sh.Columns("A:D").AutoFit
sh.[a1:d1].Font.Bold = True

MsgBox "İşlem : " & vbCr & Round(Timer - t, 3) & vbCr & "saniyede bitmiştir."
End Sub
 

Ekli dosyalar

Zeki hocam bu biraz bana uymadı çünkü benim tablom normalde 12 kolondan falan oluşmaktda data sheetim bu sheette sadece 2 kolondaki statüleri statüler sheetinden update ediyorum. ve normalde bu data sheetinde bir kaç kolonda formullerim var sizin çalışmanızı uygulamam durumunda formullerimde gidecek bu sebeple şuan kodu uyarlayamıyorum. isterseniz tablolarımı ve formullu kolonlarıda yollarım onları bozmadan çözebilirsek çok daha iyi olur ben tabloyu hazırlayıp yarın burada paylaşırım sizinle çok teşekkürler..
 
KORHAN hocam sizin kodda işyerinde İ5 makinada denedim 40 bin kaydı 4,7 dk bitirdi buda iyidir.. Ancak bulmadığı kayıtların yerine Statüsüz yazdırmamız mümkünmü çünkü bulmadığı yeri boş bırakıyor teşekkürler.
 
Birde aşağıdaki kodu deneyiniz.

İki sayfada 100 bin kayıt ile XP işletim sisteminde excel 2010 ile denediğimde işlem 5 dakika sürdü.
"İ" serisi işlemcide büyük ihtimalle daha kısa sürecektir.

Kod: 
Sub HIZLI_ARA()
    Dim Zaman As Double, X As Long, BUL As Range
    Dim S1 As Worksheet, S2 As Worksheet, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Set S1 = Sheets("Data")
    Set S2 = Sheets("Statüler")
    Set Alan = S2.Range("A2:A1048576")
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        Set BUL = Alan.Find(S1.Cells(X, 1), , , xlWhole)
        If Not BUL Is Nothing Then
            S1.Cells(X, 3) = BUL.Offset(, 2)
            S1.Cells(X, 4) = BUL.Offset(, 3)
        Else
            S1.Cells(X, 3) = "Statüsüz"
            S1.Cells(X, 4) = "Statüsüz"
        End If
    Next

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbInformation
End Sub
 
KORHAN Hocam ellerinize sağlık isteklerim karşılandı .. 94000 kayıtta 28 dk sürdü İ5 işlemcide ancak uzun sürmesinin sebebi yukardaki kodda 2 kolona bilgi yazıyo ben bunu 3 kolona çıkardım yinede gayet memnun edici.

Levent ve Zeki hocamada ilgileri için teşekkür ederim.

Son olarak korhan hocam kodun eşleştirme mantığını kısaca yazmanız mumkun mu..

bir arkadaşım bir çalışmadan bahsetmişti. yine match mantığıyla 1. barkodu statülerde ilk 10 bakıyor eşleşirse sonraki kayda geçiyor bulamazsa 11-100 arasına bakıyor bulursa yine sonraki kayda geçiyor bulmazsa 101-1000 arasına bakıyor bu böyle devam ediyor sizin mantıkda aynı mıdır ? Tşk.
 
Merhaba,

Bahsettiğiniz yöntemide denedim. Fakat işlem daha uzun sürdü. Levent bey "Match" ve "Countif" komutlarını kullanarak çözüm önerdiği için bende alternatif olarak CTRL+F yani FIND yöntemini önerdim. İki kod arasında hız farkı var. Tabi bu kullanılan donanıma göre değişiklik gösterebilir. Biz eklediğiniz örnek dosyada denemeler yapabiliyoruz. Orjinal dosyanızdaki farklılıklarda hız konusuna etkendir.

Kısaca benim önerdiğim kod CTRL+F işleminin koda yansımış halidir.

3 sütuna bilgi aktardığınızı ve işlemin 28 dakika sürdüğünü belirtmişsiniz. Bence bu da uzun bir süredir. Bilgisayarınızın güç ayarlarını kontrol edin. Belki düşük olarak ayarlı olabilir.
 
"28" dk. çok uzun süre. Çay demlenir, servise açılır. :)
 
Haklısınız Hocalarım.. Ancaak normalde ben 94 bin kayda vlook up attığımda yaklaşık 1 saati bulu bu yöntemle bunada şükür diyorum birde datamada 15 kolon var bunlardan sadece 3 kolonu bu şekilde güncelliyorum. Korhan hocam CTRL+F işlemi eşleşen kaydı buluyor sonra yanındaki atıyorum 1 yanındaki ve 2 yanındaki değerleri data sheetinde ilgili alana yazıyor mantık budur değil mi ?..

Hepinize ve bu siteye destekleri için çok çok teşekkürler..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst