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

toybuklu · 27 Kasım 2013

Evet Murat hocam Aynen İstediğim Gibi çalışıyor Ancak 5000 Kayıt bile en az 3-5 dk sürüyor. 300 bin kayıtta denedim Uzun Süre normale döenemedi not respondingde bekledi.. Kısaca çok uzun sürüyor..

Murat OSMA · 27 Kasım 2013

Bilgisayarinizin hızının da etkisi olmalı.
Hızlı bir çözüm gelmezse yarin tekrar ilgilenirim.

Korhan Ayhan · 27 Kasım 2013

Merhaba,

Aşağıdaki kodu 10.000 satır veride iş yerinde denedim. Yaklaşık 35 saniye sürüyor.

Kod:

Sub MUKERRER_BARKODLAR()
    Dim SD As Object, Veri As Variant, Son As Long, Zaman As Double
    Dim X As Long, Y As Long, Say As Long, Kayit As Long
    
    Zaman = Timer
    
    Set SD = CreateObject("Scripting.Dictionary")
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:B" & Son)
    
    Range("C:D").ClearContents
    
    ReDim Dizi(1 To 2, 1 To Son)

    For X = LBound(Veri) To UBound(Veri)
        Say = 0
        Kayit = Kayit + 1
        Dizi(1, Kayit) = Veri(X, 1)
        For Y = LBound(Veri) To UBound(Veri)
            If Veri(X, 1) = Veri(Y, 1) Then
                If Veri(Y, 2) <> True Then
                    Say = Say + 1
                    If Not SD.Exists(Veri(X, 1)) Then
                        SD.Add Veri(X, 1), Nothing
                        Dizi(2, Kayit) = Say
                    Else
                        Dizi(2, Kayit) = Say
                    End If
                End If
                Veri(Y, 2) = True
            End If
        Next
    Next
    
    Range("C2").Resize(Kayit, 2) = Application.Transpose(Dizi)
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
End Sub

Murat OSMA · 27 Kasım 2013

Korhan Bey, gönderdiğiniz kodlar 10.000 satırlık veri için bende 27 sn. sürdü.

Sanırım yapılmak istenen bu iş için, benzersizleri ayrı bir diziye alarak ilk dizi ile karşılaştırıp olanları saydırma olayı ADO' ya göre ağır işliyor.
Çünkü; daha önce ADO ile önerdiğim çözümde, 10.000 satırlık veri için bu işlem 4.125 sn. sürdü. Üstelik For döngüsü ile işlem yaptığı için biraz yavaş çalışmasına rağmen.
Ayrıca performansı artırmak için, Late Binding yöntemi yerine Early Bindind yöntemini kullanmak (Referanslardan Activex Data Objects ve Scripting Runtime seçmek) sonuçta bize birkaç sn. kazandıracaktır.

İki kodu birleştirdim. Siz de bir dener misiniz ?

Kod:

Sub Benzersizleri_Bul_Say()
    Dim Rky As Range, i As Long
    Dim Con As New ADODB.Connection
    Dim SD As New Scripting.Dictionary
    basla = Timer
    For Each Rky In Range("A2", Range("A2").End(4))
        If Not SD.Exists(Rky.Value) Then
            SD.Add Rky.Value, Rky.Value
            Cells(Rky.Row, "AD") = Rky.Value
        End If
    Next Rky
    Columns("AD:AD").NumberFormat = "@": Columns("A:A").NumberFormat = "@"
    Con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    For i = 2 To Range("AD65536").End(3).Row
        Set Rs = Con.Execute("select count(f1) from [Sayfa1$] where f1='" & Cells(i, "AD") & "' group by f1")
        Cells(i, 2).CopyFromRecordset Rs
        Rs.Close
    Next i
    Con.Close
    Columns("AD:AD").ClearContents
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - basla, "0.000")
    Set SD = Nothing

'______________________________________________________________________________________________________________
           
    Dim Veri As Variant, Son As Long, Zaman As Double
    Dim X As Long, Y As Long, Say As Long, Kayit As Long
    
    Zaman = Timer
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:B" & Son)
    Range("C:D").ClearContents
    ReDim Dizi(1 To 2, 1 To Son)
    For X = LBound(Veri) To UBound(Veri)
        Say = 0
        Kayit = Kayit + 1
        Dizi(1, Kayit) = Veri(X, 1)
        For Y = LBound(Veri) To UBound(Veri)
            If Veri(X, 1) = Veri(Y, 1) Then
                If Veri(Y, 2) <> True Then
                    Say = Say + 1
                    If Not SD.Exists(Veri(X, 1)) Then
                        SD.Add Veri(X, 1), Nothing
                        Dizi(2, Kayit) = Say
                    Else
                        Dizi(2, Kayit) = Say
                    End If
                End If
                Veri(Y, 2) = True
            End If
        Next
    Next
    Range("C2").Resize(Kayit, 2) = Application.Transpose(Dizi)
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
    i = Empty: Set Rky = Nothing: Set Con = Nothing: Set SD = Nothing
End Sub

Korhan Ayhan · 27 Kasım 2013

Merhaba Murat Bey,

Kodlarınızı deneyemedim. Aşağıdaki hatayı aldım.

Yüklenebilir ISAM bulunamadı.

Murat OSMA · 27 Kasım 2013

Korhan Bey şu kodları dener misiniz lütfen ?

Kod:

Sub Benzersizleri_Bul_Say()
    Dim Rky As Range, i As Long
    
    Dim con As ADODB.Connection
    Set con = New ADODB.Connection
    
    Dim SD As Scripting.Dictionary
    Set SD = New Scripting.Dictionary
    
    basla = Timer
    For Each Rky In Range("A2", Range("A2").End(4))
        If Not SD.Exists(Rky.Value) Then
            SD.Add Rky.Value, Rky.Value
            Cells(Rky.Row, "AD") = Rky.Value
        End If
    Next Rky
    Columns("AD:AD").NumberFormat = "@": Columns("A:A").NumberFormat = "@"
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    For i = 2 To Range("AD65536").End(3).Row
        Set Rs = con.Execute("select count(f1) from [Sayfa1$] where f1='" & Cells(i, "AD") & "' group by f1")
        Cells(i, 2).CopyFromRecordset Rs
        Rs.Close
    Next i
    con.Close
    Columns("AD:AD").ClearContents
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - basla, "0.000")
    Set SD = Nothing

'______________________________________________________________________________________________________________
           
    Dim Veri As Variant, Son As Long, Zaman As Double
    Dim X As Long, Y As Long, Say As Long, Kayit As Long
     
    Dim SC As Scripting.Dictionary
    Set SC = New Scripting.Dictionary
    
    Zaman = Timer
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:B" & Son)
    Range("C:D").ClearContents
    ReDim Dizi(1 To 2, 1 To Son)
    For X = LBound(Veri) To UBound(Veri)
        Say = 0
        Kayit = Kayit + 1
        Dizi(1, Kayit) = Veri(X, 1)
        For Y = LBound(Veri) To UBound(Veri)
            If Veri(X, 1) = Veri(Y, 1) Then
                If Veri(Y, 2) <> True Then
                    Say = Say + 1
                    If Not SC.Exists(Veri(X, 1)) Then
                        SC.Add Veri(X, 1), Nothing
                        Dizi(2, Kayit) = Say
                    Else
                        Dizi(2, Kayit) = Say
                    End If
                End If
                Veri(Y, 2) = True
            End If
        Next
    Next
    Range("C2").Resize(Kayit, 2) = Application.Transpose(Dizi)
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
    i = Empty: Set Rky = Nothing: Set con = Nothing: Set SC = Nothing
End Sub

Dosyayı da ekliyorum.

toybuklu · 27 Kasım 2013

çalıştırdığımda

Dim Con As New ADODB.Connection

bu alanda hata veriyor " User-defined type not defined"

toybuklu · 27 Kasım 2013

Birde Murat Hocam Korhan Hocam

Aşağıdaki kodu başka bir dosyamda 2 sheet teki verileri eşleştirip eşleşen verilerin I kolonuna Cirosunu, G kolonuna SBU kodunu yazdırıyorum.

Ancak şöyle bir sıkıntım var Ciro sheet inde örneğin 333,3333333 şeklindeki ciroyu Data sayfasında I kolonuna yazarken 3333333333 şeklinde yazıyor bunu bir türlü düzeltemedim nerede değişiklik yapmam gerekir yardımlarınızı rica ederim. yazdırıyorum

Kod:

Sub Fast_Vlookup_Ciro1()

    Sheets("Data").Select
    
Application.ScreenUpdating = False

    Dim zaman As Double, Dizi As Variant, X, DS As Long
    Application.StatusBar = "Destek Ekibi"

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    zaman = Timer
    
    Dizi = Sheets("CİRO_SBU").Range("A1").CurrentRegion.Resize(, 5).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 2 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 5) & "#" & Dizi(X, 3)
        Next
        
        DS = Sayfa2.Cells(Rows.Count, "A").End(xlUp).Row
                
        Dizi = Sheets("Data").Range("E1:E" & DS).Resize(, 5).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Dizi(X, 5) = Split(.Item(Dizi(X, 1)), "#")(0)
                Dizi(X, 3) = Split(.Item(Dizi(X, 1)), "#")(1)
            Else
            Dizi(X, 5) = ""
            Dizi(X, 3) = ""


            End If
        Next
    Application.StatusBar = X
    
    End With
    
    Sheets("Data").Range("G2:I" & Rows.Count).NumberFormat = "General"
    Sheets("Data").Range("e1:e" & DS).Resize(, 5) = Dizi
    

        Application.Calculation = xlCalculationAutomatic
    
    Application.StatusBar = False

    MsgBox "Statüden Veri alma tamamlandı.[İÇ]" & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - zaman), "0.00" & " sn")
End Sub

toybuklu · 27 Kasım 2013

Eklediğiniz Dosyada 10000 kayıt ilki 9 sn 2 ci kod 36 sn sürüyor şimdi büyük bir datada deneyeceğim. ik kodu..

Murat OSMA · 28 Kasım 2013

Murat OSMA' Alıntı:
Ayrıca performansı artırmak için, Late Binding yöntemi yerine Early Bindind yöntemini kullanmak (Referanslardan Activex Data Objects ve Scripting Runtime seçmek) sonuçta bize birkaç sn. kazandıracaktır.

Hata vermemesi için yazılanlara dikkat etmeniz gerek.
İlgili referansları seçip denerseniz hata almazsınız...

toybuklu · 28 Kasım 2013

Bu bahsettikleriniz bende zaten açık durumda. Ayrıca İşlem Çok uzun sürüyor ve bitmek bilmiyor gibi. Bu haliyle ufak dosyalarda bu yöntemler kullanılabilir daha fazla yormak istemem sizleri. Teşeşkkürler..

Bahsettiğim ve yukarıda kodlarını verdiğim Diğer konumdaki takıldığım noktaylada ilgilenmeniz mumkun mudur ?

Korhan Ayhan · 28 Kasım 2013

Murat Bey,

Eklediğiniz dosyayı denedim. Sizin düzenlediğiniz kodun ilk bölümü 3,3 saniyede işlemi tamamlıyor. İkinci bölümü ise 27 saniyede işlemi tamamlıyor.

Daha sonra eklediğiniz dosyadaki A sütunundaki numaraları 10.000 satır için farklı numaralar girerek denedim.

Kodun ilk bölümü kilitlendi. Yaklaşık 1 dakika bekledikten sonra durdurmak zorunda kaldım. İkinci bölüm 14,25 saniyede işlemi tamamladı.

toybuklu · 28 Kasım 2013

Korhan Hocam Bir önceki sayfada daha önce sizin yazmış olduğunuz fast vlookup kodunu başka bir çalışmamada da kullandım ancak mesajda bahsettiğim konuda takıldım yardımcı olabilirmsiniz.

333,333333333333 olan sayısı taşırken 333333333333333
şeklinde taşıyor normalde hadi yuvarlansın 333 olan rakam 33333333333333 şeklinde trilyonlu olarak taşınıyor bu sade küsüratı olan sayılarda bu şekilde ACİL yardıma ihtiyacım var bu konuda..

Korhan Ayhan · 29 Kasım 2013

Sayısal ve ondalıklı veriler için CDBL deyimini kullanabilirsiniz.

Kod:

CDbl(Split(.Item(Dizi(X, 1)), "#")(0))

Murat OSMA · 29 Kasım 2013

Korhan Ayhan' Alıntı:
Murat Bey,

Eklediğiniz dosyayı denedim. Sizin düzenlediğiniz kodun ilk bölümü 3,3 saniyede işlemi tamamlıyor. İkinci bölümü ise 27 saniyede işlemi tamamlıyor.

Daha sonra eklediğiniz dosyadaki A sütunundaki numaraları 10.000 satır için farklı numaralar girerek denedim.

Kodun ilk bölümü kilitlendi. Yaklaşık 1 dakika bekledikten sonra durdurmak zorunda kaldım. İkinci bölüm 14,25 saniyede işlemi tamamladı.

Evet Korhan Bey, dediğiniz gibi benzersiz sayısı arttığında kodlar yine ağır çalışıyor.

Satır sayısı daha da attığında, 100.000 - 200.000 satırlık veri olduğunda önerdiğiniz kodlar bile bir hayli bekletiyor. Bunu daha da hızlandırmanın bir yolu olmalı ama maalesef o yolu bulana kadar Sn. toybuklu beklemek zorunda.

100.000 satırlık veri için birkaç farklı yöntemle, sorgularla denemeler yaptım ama benzersiz sayısı arttıkça kodlar biraz daha yavaş çalışıyor hâliyle.

Kullanılan yollar:
■ Dictionary nesnesi ile benzersizleri say ve listele
■ Dictionary nesnesi ile benzersizleri say ve listele sonra for döngüsü ile kontrol et 1'den fazla ile hücreleri temizle
■ Dictionay nesnesi ile Collection nesnesinde karşılaştır say ve listele
■ Ado ile benzersizleri say ve listele
■ Ado ile benzersizleri say ve listele + Update ile 1 den fazla olan hücreleri temizle
■ Ado for döngüsü ile say ve listele
■ Sayfada filtre ve eğersay formülü ile
■ Muhtelif sütun karşılaştırma işlemleri

Ama şuan için önerdiğiniz kodlardan daha hızlı ve doğru sonuç verecek şekilde düzenleyemedim.

Ellerinize sağlık, tebrik ederim. :bravo:

Murat OSMA · 29 Kasım 2013

Bu konu namazda aklıma geldi. Sonra çıktığımda şöyle hızlandırabileceğimi düşündüm ve denedim.

10.000 satırlık ver bende 4 sn. civarı sürdü..
Sonucu sizin dosyalarınızda da dener misiniz ?

Kod:

Sub Listele()
    Dim Rky As Variant, SCD As Object, dizi As Variant
    Set SCD = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Range("BC:BD").ClearContents
    dizi = Range("A2:A" & Range("A65536").End(3).Row)
    For Each Rky In dizi
        If SCD.Exists(Rky) Then
            SCD.Item(Rky) = SCD.Item(Rky) + 1
                Else
            SCD.Add Rky, 1
        End If
    Next Rky
    Range("BC2").Resize(SCD.Count, 1).Value = _
    WorksheetFunction.Transpose(SCD.Keys)
    Range("BD2").Resize(SCD.Count, 1).Value = _
    WorksheetFunction.Transpose(SCD.Items)
    Set SCD = Nothing: Set Rky = Nothing: Erase dizi
    
    [A2].Select
5   Do While ActiveCell.Value = Cells(ActiveCell.Row, "BC")
        If ActiveCell.Value = "" Then Exit Sub
10      ActiveCell.Offset(1, 0).Select
        GoTo 5
    Loop
    Cells(ActiveCell.Row, "BC").Resize(, 2).Insert Shift:=xlDown
    GoTo 10
    Application.ScreenUpdating = True
End Sub

Sub Kopyala()
    Columns("BD:BD").Copy Columns("B:B")
End Sub

Korhan Ayhan · 29 Kasım 2013

Murat Bey,

Allah kabul etsin...

Evet son eklediğiniz dosyada 10.000 satır veride işlem 4 saniye sürüyor. Fakat veri sayısını 300.000 adet yaptığımda yine kilitlenme yaşadım.

Bende aşağıdaki kod ile bir deneme yaptım. 500.000 satır veride işlem yaklaşık olarak 20 saniye sürüyor. Fakat tüm kodlara saydığı değeri yazıyor. Bu sorunu da aşarsak sanırım sorun çözülecek.

100.000 satır veri içeren örnek dosya ektedir.

Kullandığım kod;

Kod:

Option Explicit

Sub BARKOD_SAY()
    Dim Tablo As PivotTable, Sutun As PivotField
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Dizi(), Zaman As Double
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Zaman = Timer
    
    Set S1 = ActiveWorkbook.Sheets("Sayfa1")
    S1.Select
    Range("A1").Select
    Range("B:B").ClearContents
    
    Set Tablo = Sayfa1.PivotTableWizard
    Set S2 = ActiveSheet
    Set Sutun = Tablo.PivotFields("BARKOD")
    Sutun.Orientation = xlRowField
    Set Sutun = Tablo.PivotFields("BARKOD")
    Sutun.Orientation = xlDataField
    Sutun.Function = xlCount
    S2.Cells.Copy
    S2.Cells.PasteSpecial xlPasteValues
    Range("A1").Select
    Application.CutCopyMode = False
    
    Dizi = S2.Range("A1").CurrentRegion.Resize(, 2).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 1 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2)
        Next
        
        Dizi = S1.Range("A1").CurrentRegion.Resize(, 2).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Dizi(X, 2) = .Item(Dizi(X, 1))
            End If
        Next
    End With
    
    S1.Range("A1").CurrentRegion.Resize(, 2) = Dizi
    S1.Range("B1") = "Adet"
    
    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
End Sub

Murat OSMA · 29 Kasım 2013

Bu son kodlar çok iyi ve oldukça da hızlı sonuç veriyor, bunun üzerinde yoğunlaşmak gerek.

Hızlı bir şekilde hepsine adedini yazdırabiliyorum ama tüm satırlara yazdırmama olayını ADO ile tek sorguda çözemedim.
İlave sorgu oluştuğunda performans olarak yavaşlayacağı için şu an nasıl yaparımı düşünme aşamasındayım. :dusun: :dusun:

Kod:

    rs.Open "select Barkod, count(*) as say from [Sayfa1$] group by Barkod", con, 1, 1
    Do While Not rs.EOF
        con.Execute "update [Sayfa1$] set Adet=" & rs(1).Value & " where Barkod=" & rs(0).Value & ""
        rs.MoveNext
    Loop
    rs.Close

Sizin kodlarda, Özet tabloya alıp saydıktan sonra benzersiz sayısı 1'den fazla olanların, sayı sütunlarını sildirip dizi'ye sayı kısmını boş olarak aldırmak gerek, ama nasıl ? :dusun:

Korhan Ayhan · 2 Aralık 2013

Murat Bey,

Sanırım olayı çözdüm. Veriyi tekrarlanan ilk barkoda yazdırdıktan sonra "item" deyiminde yüklü olan değeri "Empty" ile boşaltarak sorunu çözdüm. Böylece bir döngüye gerek kalmadı. Hızdan da bir şey kaybetmemiş olduk.

100.000 satırlık veride 2,15 saniyede işlem tamamlandı.

Ayrıca aynı kodu 1.000.000 satırlık bir tabloda denedim. Tabloyu oluştururken tekrarlanan mükerrer kayıt sayısını az tuttum. 1.000.000 ile 9.999.999 arası rastgele sayılar ürettim.

İşlem 111 saniyede tamamlandı.

Sayın toybuklu formülle işlemin 25 dakika sürdüğünü belirtmişti. Sanırım bu süre onun içinde yeterli olacaktır.

100.000 satırlık örnek dosya ektedir.

Kullandığım kod;

Kod:

Option Explicit

Sub BARKOD_SAY()
    Dim Tablo As PivotTable, Sutun As PivotField
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Dizi(), Zaman As Double
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Zaman = Timer
    
    Set S1 = ActiveWorkbook.Sheets("Sayfa1")
    S1.Select
    Range("A1").Select
    Range("B:B").ClearContents
    
    Set Tablo = Sayfa1.PivotTableWizard
    Set S2 = ActiveSheet
    Set Sutun = Tablo.PivotFields("BARKOD")
    Sutun.Orientation = xlRowField
    Sutun.Orientation = xlDataField
    Sutun.Function = xlCount
    S2.Cells.Copy
    S2.Cells.PasteSpecial xlPasteValues
    Range("A1").Select
    Application.CutCopyMode = False
    
    Dizi = S2.Range("A1").CurrentRegion.Resize(, 2).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 1 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2)
        Next
        
        Dizi = S1.Range("A1").CurrentRegion.Resize(, 2).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Dizi(X, 2) = .Item(Dizi(X, 1))
                .Item(Dizi(X, 1)) = Empty
            End If
        Next
    End With
    
    S1.Range("A1").CurrentRegion.Resize(, 2) = Dizi
    S1.Range("B1") = "Adet"
    
    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
End Sub

Murat OSMA · 2 Aralık 2013

Ellerinize, zihninize sağlık Korhan Bey.

Eğer mükerrer ise item değerini boşalt dediniz, olması gereken de tam olarak buydu.
Şimdi nasıl oldu da aklımıza gelmedi diyoruz ama, malûm bazen gözümüzün önündekini bile göremediğimiz oluyor, sakin kafayla temiz bir zihinle üzerinden tekrar geçildiğinde kendini o kadar belli ediyor ki. Sanırım bu çözüm de böyle bir durumda geldi.

Bu şekilde sonuç tek kelimeyle mükemmel.

k::
Tekrar tebrik ve teşekkür ediyorum. Oldukça da kullanışlı bir yöntemle hazırlanmış güzel bir kod kazandırdınız, sağ olun.

Sn. toybuklu, size ne kadar teşekkür etse azdır. 25 dk. dan 2-3 sn.'ye.. müthiş bir hız...

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

toybuklu

Murat OSMA

Altın Üye

Korhan Ayhan

Administrator

Murat OSMA

Altın Üye

Korhan Ayhan

Administrator

Murat OSMA

Altın Üye

Ekli dosyalar

toybuklu

toybuklu

toybuklu

Murat OSMA

Altın Üye

toybuklu

Korhan Ayhan

Administrator

toybuklu

Korhan Ayhan

Administrator

Murat OSMA

Altın Üye

Murat OSMA

Altın Üye

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

Murat OSMA

Altın Üye

Korhan Ayhan

Administrator

Ekli dosyalar

Murat OSMA

Altın Üye