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

[toybuklu]

Merhaba Korhan Hocam Ben kodu koydum çalıştı ancak bitmedi uzun süre bekliyor sonrasında notrespnding oluyor. Bilgilerinize sunarım.

 

[Korhan Ayhan]

Mesajınızdan sonra tekrar denedim. 500.000 kayıtta yine aynı sonucu aldım. Makine performansı ile alakalı olabilir. Siz kaç kayıtta deneme yaptınız.

 

[toybuklu]

Bende 250 bin kayıtta denedim sizin kodlardan yola çıkarak bişeyler yaptık çok teşekkür ederim ilgi ve alakanıza saygılarımla..

 

[Necdet]

Bende 250 bin kayıtta denedim sizin kodlardan yola çıkarak bişeyler yaptık çok teşekkür ederim ilgi ve alakanıza saygılarımla..

İlgi = Alaka

Aynı anlamdaki bu iki sözcüğü sanki farklı sözcüklermiş gibi bir de araya ve koyarak neden kullanırsınız ki?

 

[toybuklu]

Tekrar Merhaba Uzman arkadaşlar..

Yeni bir noktada takıldım yardımlarınızı rica ederim.

Ek adrese yüklediğim dosyamda A kolonundaki barkodların kaç tane olduğunu Tablonun sonunda saydırmak istiyorum.

Örneğin A2 hücresindeki barkodun A kolonunda kaç tane olduğunu son kolona yazdırmak istiyorum.

Ancak diyelimki 3 tane buldu sadece 1 tanesine yazmasını diğerlerini boş bırakmasını istiyorum..

Bu işlemi CountIf ile yada formuller ile yaptığımda sayması 25 dk Sürdü KORHAN Hocamın Dizi yöntemiyle yada Hızlı bir yöntemle bunu yapmak mumkunmudur..

Yardımlarınız için şimdiden teşekkürler.

Not: adresdeki dosyamda mükerer kayıt olmayabilir bazı barkodları çoklayıp işlem yapılabilir.

Dosyayı Siteme Upload etmiştim daha önce dosya büyüklüğünden dolayı.

http://www.toybuk.org/upload/Takip_Çalismasi_Deneme.rar

 

[numan şamil]

Peki "mükerrer" ifadesi tüm kayıtlaramı yazılsın. Yoksa ilki hariç diğer kayıtlara mı yazılsın. Yani sonucun aşağıdaki örneklerden hangisi gibi olmasını istiyorsunuz.

Örnek;

Elma Mükerrer
Elma Mükerrer
Ayva
Elma Mükerrer

Ya da;

Elma
Elma Mükerrer
Ayva
Elma Mükerrer

Merhaba
Ekli dosyadaki mükerrerlere
dosyada belirtiğim şekilde ekleme yapabilecek kod yazılabilinirmi

 

[toybuklu]

Konu 2224 Kere Görüntülenmiş Umarım benim gibi pek çok kişinin işine yaramıaştır. Korhan Hocam yeni konu ile ilgilide yardımlarınızı rica ederim..

Saat 17:50 deki yukarıdaki yazımda bahsettiğim konu..

 

[Korhan Ayhan]

Numan Bey,

Aşağıdaki kodu dener misiniz?

Option Explicit

Sub KONTROL()
    Dim Son As Long, Alan As Range, Veri As Variant
    Dim X As Long, Y As Long, Say As Long, Zaman As Double
    
    Zaman = Timer
    Son = Cells(Rows.Count, 1).End(3).Row
    Set Alan = Range("A3:A" & Son)
    Veri = Range("A3:A" & Son)
        
    ReDim Dizi(1 To 1)
        
    For X = 1 To UBound(Veri)
        Y = Y + 1
        ReDim Preserve Dizi(1 To Y)
        Say = WorksheetFunction.CountIf(Alan.Resize(Y), Veri(X, 1))
        If Say > 1 Then
            Dizi(Y) = Veri(X, 1) & "-" & Say - 1
        Else
            Dizi(Y) = Veri(X, 1)
        End If
    Next
    
    Range("B3").Resize(Y).NumberFormat = "@"
    Range("B3").Resize(Y) = Application.Transpose(Dizi)
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000")
End Sub

 

[numan şamil]

Korhan Bey çok teşekkür ederim

 

[Murat OSMA]

■ Alternatif;

Sub Aynı_ise_Artır()
    Dim i As Integer, say As Integer
    Columns(2).ClearContents
    For i = 3 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("A3:A" & i), Cells(i, 1)) > 1 Then
            say = 1
            Cells(i, 2) = Cells(i, 1) & "-" & say
            say = say + 1
5       If WorksheetFunction.CountIf(Range("b3:b" & i), Cells(i, 2)) > 1 Then
            If Right(Range("B65536").End(3).Value, 2) > 9 Then
                say = Right(Range("B65536").End(3).Value, 2) + 1
                    Else
                say = Right(Range("B65536").End(3).Value, 1) + 1
            End If
            Cells(i, 2) = Cells(i, 1) & "-" & say
            GoTo 5
            say = Right(Range("B65536").End(3).Value, 1) + 1
        End If
            Else
            Cells(i, 2) = Cells(i, 1)
        End If
    Next i
    i = Empty: say = Empty
End Sub

 

[toybuklu]

Merhaba Korhan Hocam;

Kodu örnek bir dosyada kendime göre uyarladım.

Ek dosyada göreceğiniz üzere ard arda 2 aynı kayıt varsa sıkıntı yok ancak fazla kayıt varsa her 2 kaydı kendi içinde sayıyor.

benim istediğim kolonda ilgili kayıttan kaç tane varsa 1 tanesinin yanına sayısını yazması.

yalnız bu aynı kayıtlar arda arda olmayabilir.

Yardımlarınıza teşekkürler. (birde bu çalışma dizi yöntemiyle olması hız bakımından öncemli.sayenizde. )

 

[Korhan Ayhan]

Bir yanlış anlaşılma var. Ben kodu Numan beye önermiştim. Sizin sorunuza henüz bakamadım.

 

[toybuklu]

Bende Numan beye verdiğiniz kodu biraz kırptım kendime uyarlamıştım. desteklerinizi bekliyorum. TŞK.

 

[toybuklu]

Korhan Hocam Yardımlarınızı Bekliyorum Saygılarımla..

 

[Murat OSMA]

Şu kodları kullanabilirsiniz;

Sub Benzersizleri_Listele_Say()
    Dim con As Object, sorgu As String
    
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
    
    Set rs = con.Execute("select f1,count(f1) from [Sayfa1$A2:A34] group by f1")
    Range("B2").CopyFromRecordset rs
    rs.Close: con.Close
    
    sorgu = "": Set rs = Nothing: Set con = Nothing
End Sub

 

[toybuklu]

Merhaba Murat Hocam;

Kodu denedim ancak 65000 kayıttan fazlasında çlışmıyor 200-300 bin kayıt aralığında kullanmam gerekiyor.

Ayrıca B kolonuna barkodları teke düşürüp yanlarına kaç kere olduğunu yazıyor benim ihtiyacım. yanda teke düşürmeden A kolonundaki barkodların yanına mükerer olanlardan sadece 1 tanesine o barkodun o kolonda kaç tane olduğunu yazmak sizin kodunuzda gayet güzel çalışıyor ancak bahsettiğim şekilde ihtiyacım var.

 

[Murat OSMA]

Aralık belirttiğim için hata alıyorsunuz.

[Sayfa1$A2:A34] kısmını [Sayfa1$] olarak düzeltildiğinde tüm sütunu saydırabilirsiniz.
Yan hücreye yazdırma konusunda birazdan dönüş yaparım.

 

[toybuklu]

Merhaba Murat bey bahsettiğiniz değişikliği yaptım OK.

Barkodları yan kolonda teke düşürmeden A kolonu yanında barkodun yanı kaç kere olduğunu yazma için beklemedeyim..

Aslında bunu Korhan beyin DİZİ yöntemiyle yapmayı da isterim çünkü başka çalışmalarda VBA kodlarını uyarlamak daha kolay oluyor işin için SQL falan girince benim kafa takılıyor

Yardımlarınız için teşekkür ederim.

 

[Murat OSMA]

Bakamadım dosyaya kusura bakmayın şimdi hazırlıyorum.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Benzersizleri_Bul_Say()
    Dim Scr As Object, con As Object, Rky As Range, i As Long
    Set Scr = CreateObject("Scripting.Dictionary")
    For Each Rky In Range("A2", Range("A2").End(4))
        If Not Scr.Exists(Rky.Value) Then
            Scr.Add Rky.Value, Rky.Value
            Cells(Rky.Row, "AD") = Rky.Value
        End If
    Next Rky
    Columns("AD:AD").NumberFormat = "@": Columns("A:A").NumberFormat = "@"
    Set con = VBA.CreateObject("adodb.connection")
    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
    i = Empty: Set Rky = Nothing: Set con = Nothing: Set Scr = Nothing
End Sub

Aceleyle yazdım, 300.000 satırlık veri için hız konusunda bir şey diyemem bir bakın bakalım istediğiniz gibi mi ?