Hızlı Vlookup

[mciritci75]

Üstadlarım ,,
verdiğiniz kodları bendeki calısma dosyasına eklemeye calısıyorum ancak birtürlü tam istediğimi yapamadım.

sürekli rs.Open q, cn hatası verıyor , ıstedıgım yapılabılırmı yardımcı olabılırmsınız

teşekkurler

 

[acar6783]

Dosya içindeki soruya göre cevap böyle ama sizin kodlar cok farklı
Anlamadan yazmış olabilirim

 

[acar6783]

Evet farklı bir konuda aynı soruyu sormuşssunuz o sebepten benim cevabım sizin dosyaya uymayacaktır

 

[mciritci75]

ılgın ıcn tsk ederım ancak sızın verdıgınız codelar U:U stunundakı verılerı clear yapıyor.
getırmesı gerekırken siliyor

 

[acar6783]

ılgın ıcn tsk ederım ancak sızın verdıgınız codelar U:U stunundakı verılerı clear yapıyor.
getırmesı gerekırken siliyor

Önce siler sonra getirir ama dögüsel veri çektiği için sizin dosyanızda donmalara sebep olabilir.

 

[Ömer BARAN]

Merhaba.
Belgenizde mevcut kodları hiç çalıştırmadım.
Aşağıdaki kodu çalıştırarak "L"stunundakı veri ,"F" stununda varsa "G" stunundakı veriyi "U" sütununa aktarabilirsiniz.

Sub BARAN()
Range("U2:U" & [J65536].End(3).Row).ClearContents
For a = 2 To [L65536].End(3).Row
        If WorksheetFunction.CountIf(Range("F2:F" & [F65536].End(3).Row), Cells(a, 12)) = 0 Then GoTo 10
    b = WorksheetFunction.Match(Cells(a, 12), Range("F1:F" & [F65536].End(3).Row), 0)
    Cells(a, 21) = Cells(b, 7)
10
Next
End Sub

 

[mciritci75]

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

q = "SELECT `Data$`.aranan data, `Data$`.isim," & _
"FROM `Data$`" & _
"WHERE `Data$`.aranan data = `Data$`.isim"

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").AutoFit
sh.[a1:d1].Font.Bold = True

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

yukarıdakı makro tam ıstedıgım gıbı ama F , G stunlarını ayarlayamıyrouz

 

[Ömer BARAN]

Merhaba, mesaja ekleyeceğiniz kodları;
mesaj metnini yazdığınız alanın hemen üstteki biçimlendirme kısmının en sağındaki # simgesini fareyle tıklayarak oluşan CODE köşeli parantezlerinin arasına yapıştırmanız daha doğru olur.

Gönderdiğim cevaptaki kod'u denediniz mi acaba?
Sonuç alamadınız mı?

 

[mciritci75]

evet ekledım bu kodu ama istediğimi yapmıyor.

 

[Ömer BARAN]

Test etmeden cevap yazmam, bilgisayar başında değilim, gece geç vakit belgeye eklenmiş olarak gönderirim.

 

[Ömer BARAN]

Gönderdiğim kod'un eklenmiş olduğu belgeniz ekte.
Sorun göremiyorum.
İstediğiniz işlem gerçekleşiyor.

 

[Erdem Akdemir]

Merhaba,

Yapmak istediğiniz işlemi tam olarak anlayamadım ama sorgu yazımında hatalar yapmışsınız. Aşağıdaki kodu inceleyiniz.

Sub test()
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ActiveWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes;imex=1"""


q = "SELECT [Data$].[count] FROM [Data$] WHERE [Data$].[aranan data] = [Data$].isim"



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

 

[mciritci75]

aslında yapmak ıstedıgım basıt vlookup işlemini oledb ıle vba uzerınden yapmak. bu sekılde buyuk datalarda uzun sure beklemeyecegım.

dosyayı tekrar ekledım ve yapmak ıstedıgım kodları yerlestırdım.

Sub test()
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
cn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ActiveWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes;imex=1"""


q = "SELECT [Data$].[Aranan_data] FROM [Data$] WHERE [Data$].[self] = [Data$].aranan_data"


t = Timer


rs.Open q, cn


sh.[Q2].CopyFromRecordset rs

rs.Close
cn.Close


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

 

[Zeki Gürsoy]

ADO & Sql kullanabilmeniz için eşleşecek iki sütunun da aynı veri tipinde olması gerekir. Sağ tuş ile "hücre biçimlendir" yapın; farkı göreceksiniz.

 

[mciritci75]

zeki hocam sanırım benım sorunum sadece hucre bicimiyle ilişkili degıl . kod hata verıyor
sızın bır calısma vardı o cok guzel calısıyor ancak bu dosyaya uyarlayamadım.

rs.Open q, cn hatası

 

[Korhan Ayhan]

Kod içindeki sayfa adını güncellemeniz gerekiyor.

Data$ yazan yerleri Sheet1$ olarak güncelleyip deneyin.

Tabi veri gelebilmesi için Zeki beyin uyarısını dikkate almalısınız.

 

[mciritci75]

selam korhan hocam dataları ıkıye boldum ıkı ayrı sheet uzerınden calısmayı denedım ektekı code ıle döngüyude farklı bır dosyada denedım ama 100 dk gıbı surelerde sonuclanıyor

yokmudur hızlı yolu
sızın dıger yazılarınızda soruna aıt calısmalarınızı gordum ama ektekı dosyama bır turlu uyarlamadım.

yardımcı olurmusunuz rıca etsem

 

[Zeki Gürsoy]

Dosyayı "C:\deneme\deneme.xlsx" olacak şekilde yerleştirin. Çünkü bağlantı dizesi buna göredir.

Deneme için birkaç numarayı değiştirin. "Sonuç" sayfasında sarı alan üzerinde sağ klik "Yenile" dediğinizde sonuç yaklaşık 1 saniyede dönecektir.

Dosya ektedir.

Sorgu :

SELECT  `data1$`.Gsm_No, `gsmdata$`.Count
FROM `data1$` `data1$` 
LEFT OUTER JOIN `gsmdata$` `gsmdata$` 
ON `data1$`.Gsm_No = `gsmdata$`.Aranan

Sorguyu yenilerken sorun devam ediyorsa aşağıdaki metni uzantısı dqy olacak şekilde notepad ile kaydettikten sonra bu dosyayı excel ile açarsanız direkt sorgu sonucu ekrana gelir.

XLODBC
1
Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=C:\deneme\deneme.xlsx
SELECT  `data1$`.Gsm_No, `gsmdata$`.Count  FROM `data1$` `data1$` LEFT OUTER JOIN `gsmdata$` `gsmdata$` ON `data1$`.Gsm_No = 

`gsmdata$`.Aranan


Gsm_No    Count

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Fast_Vlookup()
    Dim Zaman As Double, Dizi As Variant, X As Long
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
        
    Zaman = Timer
    
    Sheets("data1").Range("P2:P" & Rows.Count).ClearContents
    
    Dizi = Sheets("gsmdata").Range("A1").CurrentRegion.Resize(, 2).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = 2 To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 1) & "#" & Dizi(X, 2)
        Next
        
        Dizi = Sheets("Data1").Range("E1").CurrentRegion.Resize(, 12).Value
        
        For X = 2 To UBound(Dizi, 1)
            If .Exists(Dizi(X, 3)) Then
                Dizi(X, 12) = Split(.Item(Dizi(X, 3)), "#")(1)
            Else
                Dizi(X, 12) = "Bulunamadı"
            End If
        Next
    End With
    
    Sheets("data1").Range("E2:E" & Rows.Count).NumberFormat = "d.m.yy h:mm;@"
    Sheets("data1").Range("F2:F" & Rows.Count).NumberFormat = "hh:mm;@"
    Sheets("data1").Range("E1").CurrentRegion.Resize(, 12) = Dizi
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub

 

[Erdem Akdemir]

Dosyayı "C:\deneme\deneme.xlsx" olacak şekilde yerleştirin. Çünkü bağlantı dizesi buna göredir.

Deneme için birkaç numarayı değiştirin. "Sonuç" sayfasında sarı alan üzerinde sağ klik "Yenile" dediğinizde sonuç yaklaşık 1 saniyede dönecektir.

Dosya ektedir.

Sorgu :

SELECT  `data1$`.Gsm_No, `gsmdata$`.Count
FROM `data1$` `data1$` 
LEFT OUTER JOIN `gsmdata$` `gsmdata$` 
ON `data1$`.Gsm_No = `gsmdata$`.Aranan

Sorguyu yenilerken sorun devam ediyorsa aşağıdaki metni uzantısı dqy olacak şekilde notepad ile kaydettikten sonra bu dosyayı excel ile açarsanız direkt sorgu sonucu ekrana gelir.

XLODBC
1
Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=C:\deneme\deneme.xlsx
SELECT  `data1$`.Gsm_No, `gsmdata$`.Count  FROM `data1$` `data1$` LEFT OUTER JOIN `gsmdata$` `gsmdata$` ON `data1$`.Gsm_No = 

`gsmdata$`.Aranan


Gsm_No    Count

Zeki bey sayenizde birşey daha öğrenmiş oldum.