Kapalı Dosyalardan Veri Bulmak

[mustafa1205]

Ekteki klasörde bulunan 3 adet excel dosyasında yaklaşık 60.000 satırlık veri mevcut. Sevgili Yurttaş Hocamın GOOGLE gibi arama örneğini kendime uyarlamaya çalıştım ancak başarılı olamadım. Yapmak istediğim arama dosyasını açarak T.C. numarasını girerek kapalı olan 3 dosya da arama yapıp T.C. numarasına uygun olan verileri getirmeyi istiyorum. Sitede ki örnekleri inceledim ama maalesef kendime uyarlayamadım.

 

[Orion1]

Dosyanız ektedir.
ADO kullanarak hızlı bir biçimde verileri aldık.

Sub aktar59()
Dim dosya As String, yol As String, conn As Object, rs As Object, sat As Long
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("adodb.recordset")
Range("A6:[B][COLOR="Red"]K[/COLOR][/B]" & Rows.Count).ClearContents
Application.ScreenUpdating = False
yol = ThisWorkbook.Path
dosya = yol & "\*.xls"
dosya = Dir(dosya)
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & yol & "\" & _
                dosya & ";extended properties=""excel 8.0;hdr=no;imex=1""")
        rs.Open "select * from [VERİ$A2:[B][COLOR="Red"]K[/COLOR][/B]65536] where F2=" & _
                CDbl(TextBox1.Value), conn, 1, 1
        sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Range("A" & sat).CopyFromRecordset rs
        rs.Close
        conn.Close
    End If
    dosya = Dir
Loop
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[mustafa1205]

Sevgili Evren Hocam çok teşekkür ediyorum. Tam istediğim gibi olmuş. Bir şey sormak istiyorum. Benim örnek dosyalarımda veriler A sütunundan E sütununa kadar gidiyor. Bu veriler K sütununa kadar giderse kod da nereyi değiştirmeliyiz. Kodlara baktım. E olan kısımları K yaptım ancak olmadı?

 

[Orion1]

Dosyayı güncelledim.
değişiklik yaptığım yeri koyu kırmızı renkle boyadım.
2 nolu mesajdan indirebilirsiniz.

Sevgili Evren Hocam çok teşekkür ediyorum. Tam istediğim gibi olmuş. Bir şey sormak istiyorum. Benim örnek dosyalarımda veriler A sütunundan E sütununa kadar gidiyor. Bu veriler K sütununa kadar giderse kod da nereyi değiştirmeliyiz. Kodlara baktım. E olan kısımları K yaptım ancak olmadı?

 

[mustafa1205]

Hocam çok sağolun. Emeğinize sağlık. Yarın asıl dosyada denemesini yapıp size sonucunu bildiririm.

 

[Orion1]

Hocam çok sağolun. Emeğinize sağlık. Yarın asıl dosyada denemesini yapıp size sonucunu bildiririm.

Rica ederim.
iyi geceler.

 

[m.ensar]

Dosyanız ektedir.
ADO kullanarak hızlı bir biçimde verileri aldık.

Sub aktar59()
Dim dosya As String, yol As String, conn As Object, rs As Object, sat As Long
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("adodb.recordset")
Range("A6:[B][COLOR="Red"]K[/COLOR][/B]" & Rows.Count).ClearContents
Application.ScreenUpdating = False
yol = ThisWorkbook.Path
dosya = yol & "\*.xls"
dosya = Dir(dosya)
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & yol & "\" & _
                dosya & ";extended properties=""excel 8.0;hdr=no;imex=1""")
        rs.Open "select * from [VERİ$A2:[B][COLOR="Red"]K[/COLOR][/B]65536] where F2=" & _
                CDbl(TextBox1.Value), conn, 1, 1
        sat = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Range("A" & sat).CopyFromRecordset rs
        rs.Close
        conn.Close
    End If
    dosya = Dir
Loop
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

Hocam ekteki dosyanızı indirdim ek resimdeki hatayı verdi. office 2016 kullanıyorum. bu problemi düzeltebilir miyiz? bir de sadece bir klasörde değilde örneğin listeler klasörü içerisindeki A B C D gibi diğer klasörler içerisindeki excellerde de arama yapabilir mi?

 

[m.ensar]

Hocam bu sayfada aradığım şeyi buldum daha önce kulomer46 üstadım cevaplamış sağolsun

klasörde ki tüm çalışma kitaplarında TC numarası ile sorgulama

Arkadaşlar merhaba forumda çok aradım bulamadım. bir klasör içinde farklı özelliklerde kitaplar var bu kitapların sayfa sayılarıda değişiklik göstermekte. istediğim ise herhangi bir tc numarası arattırdığımda bu kitaplarda yok ise bulunmadı yada kayıt yok demesi, var ise atıyorum sed kitabı ret...

www.excel.web.tr

 

[m.ensar]

klasörde ki tüm çalışma kitaplarında TC numarası ile sorgulama

Arkadaşlar merhaba forumda çok aradım bulamadım. bir klasör içinde farklı özelliklerde kitaplar var bu kitapların sayfa sayılarıda değişiklik göstermekte. istediğim ise herhangi bir tc numarası arattırdığımda bu kitaplarda yok ise bulunmadı yada kayıt yok demesi, var ise atıyorum sed kitabı ret...

www.excel.web.tr