Ado ile Hücre değerlerine göre sonuç getirme

[bunyaming]

Merhaba,

Eklediğim dosya da sayfa2 de örnek veriler var. Sayfa1 de ise yanına sonuç getirmeye çalıştığım değerler var.
özetle ado ile düşeyara yapmak istiyorum
ado ile döngü yapılabiliyormu veya selection.change ile çözüm bulabilirmiyim diye bir kaç zamandır araştırdım ama sonuç elde edemedim.

şayet bunun bir yolu varsa yardımcı olursanız çok sevinirim kapalı bir dosyadan yaklaşık 100 bin satırlık veriyi belli şartlara göre aratmam gerekiyor

yolu gösterirseniz çok sevinirim

teşekkürler

 

[Muzaffer Ali]

Merhaba.

Tam anlamadım ama galiba aşağıdaki kodlar işinizi görüyor.

Sub deneme()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim ws As Worksheet
    Dim il As String
    Dim ay As String
    Dim Bak As Integer
    Set ws = Sheets("sayfa1")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
        ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
    For Bak = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        sorgu = "select [rakam] from [Sayfa2$] where İL ='" & ws.Cells(Bak, "A").Text & "' and AY='" & ws.Cells(Bak, "B").Text & "'"
        rs.Open sorgu, conn
        ws.Cells(Bak, "C").CopyFromRecordset rs
        rs.Close
    Next
    conn.Close
End Sub

 

[bunyaming]

teşekkürler Hocam

 

[Korhan Ayhan]

Alternatif;

Aynı klasör içinde (Kitap1.xlsx) isimli kapalı dosyanın (Sayfa1) isimli sayfasından veriler alınmaktadır.

Kitap1 dosyasında sorgulanan aralık olarak 100 satırlık bir aralık tanımlamıştır.

Açık çalışma kitabında ise 100.000 satırlık veri oluşturulmuştur. Veriler yaklaşık 2-3 saniyede gelmektedir. Süre veri çokluğuna göre değişecektir.

Option Explicit

Sub Kapali_Dosyadan_Veri_Al()
    Dim Yol As String, Dosya_Adi As String, Sayfa_Adi As String
    Dim S1 As Worksheet, X As Long, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya_Adi = "[Kitap1.xlsx]"
    Sayfa_Adi = "Sayfa1"
    
    Set S1 = Sheets("Sayfa1")
    
    S1.Range("C2:C" & Rows.Count).ClearContents
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    S1.Range("C2").FormulaArray = "=INDEX('" & Yol & Dosya_Adi & Sayfa_Adi & "'!C$1:C$100,MATCH(A2&B2,'" & Yol & Dosya_Adi & Sayfa_Adi & "'!A$1:A$100&'" & Yol & Dosya_Adi & Sayfa_Adi & "'!B$1:B$100,0))"
            
    With S1.Range("C2:C" & Son)
        .FillDown
        .Value = .Value
    End With
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[bunyaming]

Sağolun hocam
150 bin satırlık datadan (kapalı dosya)
20 bin satırlık aranan karşılığını bu yolla 156 saniyede getirdi
sayenizde bir yöntem daha öğrendim
çok teşekkürler

 

[emsey]

Merhaba.

Tam anlamadım ama galiba aşağıdaki kodlar işinizi görüyor.

Sub deneme()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim ws As Worksheet
    Dim il As String
    Dim ay As String
    Dim Bak As Integer
    Set ws = Sheets("sayfa1")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
        ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
    For Bak = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        sorgu = "select [rakam] from [Sayfa2$] where İL ='" & ws.Cells(Bak, "A").Text & "' and AY='" & ws.Cells(Bak, "B").Text & "'"
        rs.Open sorgu, conn
        ws.Cells(Bak, "C").CopyFromRecordset rs
        rs.Close
    Next
    conn.Close
End Sub

üstad benim şu aşağıdaki koda istinaden
sorgu = "select [rakam] from [Sayfa2$] where İL ='" & ws.Cells(Bak, "A").Text & "' and AY='" & ws.Cells(Bak, "B").Text & "'"

şu şekilde kodum var. Tarih üzerinden where yapıp g1 hücresine tarih yazınca hata veriyor. where fruit üzerinden yapınca çalışıyor. g1 hücresine tarih yazıp getirmek istiyorum çalışmıyor. Nasıl bir yol izlemek gerekiyor. yardımcı olabilir misiniz?

Dim ws As Worksheet
Set ws = Sheets("Out")
' Create the query
Dim query As String
query = "Select Tarih,Fruit,Sales,Miktar from [Simple$] where Tarih ='" & ws.Cells(1, 7).Text & "'"

 

[Haluk]

Bilgi için;

2 No'lu mesajda Muzaffer Ali Bey'in önerisindeki sorguyu aşağıdaki gibi değiştirirsek, For-Next döngüsü kullanmaya gerek kalmaz.

Sub deneme2()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
        
    sorgu = "Select T2.[RAKAM] " & _
             "From [Sayfa1$] as T1 " & _
             "Left Join " & _
             "[Sayfa2$] As T2 " & _
             "On T1.[İL] = T2.[İL] And T1.[AY] = T2.[AY]"
        
    rs.Open sorgu, conn
    Sheets("Sayfa1").Range("C2").CopyFromRecordset rs
    rs.Close
    conn.Close
End Sub

.

 

[emsey]

Yardımcı olabilecek kimse yok mu acaba halen yapamadım.

query içindeki where Tarih yapıp hücreden tarihi aldımak istiyorum ama tarih dışında her şey çalışıyor tarih çalışmıyor.

yeni_sayfa = ActiveSheet.Name

üstad benim şu aşağıdaki koda istinaden
sorgu = "select [rakam] from [Sayfa2$] where İL ='" & ws.Cells(Bak, "A").Text & "' and AY='" & ws.Cells(Bak, "B").Text & "'"

şu şekilde kodum var. Tarih üzerinden where yapıp g1 hücresine tarih yazınca hata veriyor. where fruit üzerinden yapınca çalışıyor. g1 hücresine tarih yazıp getirmek istiyorum çalışmıyor. Nasıl bir yol izlemek gerekiyor. yardımcı olabilir misiniz?

Dim ws As Worksheet
Set ws = Sheets("Out")
' Create the query
Dim query As String
query = "Select Tarih,Fruit,Sales,Miktar from [Simple$] where Tarih ='" & ws.Cells(1, 7).Text & "'"

 

[Mehmet Şahin]

İlgili alanın tarih olması koşulu ile aşağıdaki gibi dener misiniz?

where Tarih =#" & cdate(ws.Cells(1, 7)) & "#"

 

[emsey]

İlgili alanın tarih olması koşulu ile aşağıdaki gibi dener misiniz?

where Tarih =#" & cdate(ws.Cells(1, 7)) & "#"

yok üstad bu şekilde de olmadı. where Tarih ='" & cdate(ws.Cells(1, 7)) & "'" şeklinde ' işareti koyarakta olmadı. ' işareti kaldırarak olmadı. En son Cell(1,7)'yi a1 hücresine aldım

siparistarih = Range("A1").Value * 1

yaparak 1 ile çarptım sonra "where Tarih = " & siparistarih & "" yaptım oldu. çalıştı ama doğrusu bu mudur bilmiyorum ben böyle çözüm bulamayınca saçma sapan şeyler yapıyorum. Doğrusuna yardımcı olan olursa düzelteceğim olmazsa artık tarihi 1 sayısı ile çarpacağım

 

[Haluk]

SQL sorgusundan önce;

siparistarih  = cdbl(range("A1"))

deneyin....

.

 

[Zeki Gürsoy]

MS Jet database tarih biçimi için # sembolü mm/dd/yyyy veya m/d/yy olabilir. Bugün tarihi için örnek; #02/24/2022# tırnaksız olmalıdır.

.

 

[emsey]

Buda oldu üstad teşekkür ederim. Cevap için teşekkürler.

SQL sorgusundan önce;

siparistarih  = cdbl(range("A1"))

deneyin....

.

 

[emsey]

Cevap için teşekkür ederim. üstad ben siparistarih = cdbl(range("A1") ile dinamik olarak düzelttim şimdilik. Çok sağolasın.

MS Jet database tarih biçimi için # sembolü mm/dd/yyyy veya m/d/yy olabilir. Bugün tarihi için örnek; #02/24/2022# tırnaksız olmalıdır.

.

 

[ayhanhoca]

açık dosya ve kapalı dosya nedir?
normal excel açıp oluşturduğumuz excel sayfası ne oluyor ?
teşekkürler...

 

[Korhan Ayhan]

Açık dosya o anda ekranda gördüğünüz ve içinde işlem yaptığınız dosyadır.

Kapalı dosya ise bir yerde kaydedilmiş ve o anda ekranda açık olmayan kapalı şekilde bekleyen excel dosyasıdır.

Bu ifadeler genellikle ADO işlemlerinde kullanılır.

ADO açık bir excel dosyasına başka bir dosyadan veri almak için kullanılır. Bu uygulamada diğer dosyanın açık olmasına gerek yoktur.

Bu sebeple açık dosya ve kapalı dosya ifadeleri kullanılarak yorumlanırlar.