Excel-Access sorgu yapma

[Oppenheimer]

Arkadaşlar iyi günler elimde 70 mb büyüklüğünde dosya var ben bu dosya içinde sorgu yaptırıyorum normal olarak dosya kasıyor sorum şu dosyayı Access uygulamasına yüklesem sorguyu oradan nasıl çekebilirim access ile hiçbir fikrim yok örnek olarak Excel dosyamı ve ufak veri olan Access dosyamı paylaşıyorum.Bu arada SHEETST1 sayfasında örnek var

https://drive.google.com/file/d/1R_KGr8eFWPHbM-DCqJlGExueBz-cKC2A/view?usp=sharing

https://drive.google.com/file/d/1KP4tse94W8Lx2A-JLJexBUO42Y7-fgIc/view?usp=sharing

 

[Korhan Ayhan]

Aşağıdaki sorguyu bir deneyiniz.

Belki Access dosyasına gerek kalmadan sorunu çözebiliriz.

Option Explicit

Sub Search_Data()
    Dim S1 As Worksheet, S2 As Worksheet, Process_Time As Double
    Dim My_File As String, My_Query As String
    Dim My_Connection As Object, My_Recordset As Object
    
    Process_Time = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("datasu")
    Set S2 = Sheets("SHEETST1")
    
    S2.Range("A9:F" & S2.Rows.Count).Clear
    
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
    
    My_File = ThisWorkbook.FullName
    
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    My_File & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    My_Query = "Select * From [" & S1.Name & "$E:J]" & _
               " Where [OBJECTID] = " & S2.Range("F2").Value & _
               " And [TANIM] = '" & S2.Range("G2").Value & "'" & _
               " And [SERIT] = '" & S2.Range("H2").Value & "'" & _
               " And [CINS] = '" & S2.Range("I2").Value & "'" & _
               " And [SHAPE_Length] = " & S2.Range("J2").Value
    
    Set My_Recordset = My_Connection.Execute(My_Query)
           
    S2.Range("A9").CopyFromRecordset My_Recordset
    S2.Range("A9").CurrentRegion.Borders.LineStyle = 1

    If My_Recordset.State <> 0 Then My_Recordset.Close
    If My_Connection.State <> 0 Then My_Connection.Close
    
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub

 

[Oppenheimer]

Hocam yeni gördüm cevabınızı evet verdiğiniz kodlar çok hızlı ama dosya boyutu yüksek olduğu için dosyadan kaynaklı bir kasma sorunu var onun için verileri bir veritabanında tutup ordan çağırabilir miyim diye düşünmüştüm.

 

[Haluk]

Alternatif bir dosya ektedir;

Sorgu sonuçları bir Access dosyasına aktarıldıktan sonra, oradan Excel'e alınmaktadır...

Ama 70 MB'lık dosyada durum ne olur, bilemiyorum.

DATA_HD.xlsb dosyasını indir - download

DATA_HD.xlsb dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

.