Kapalı klasördeki kitaplardan Fiyatları arayıp bul

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
VBA:
Sub Dosyalar_Ado()
'Dosyalar arası bilinmeyen sayfalarda koşullu veri çekme
'Feyzullah KILINÇ metehan8001**** 14.07.2019
Set con = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
Set cat = CreateObject("adox.catalog")
Set tbl = CreateObject("adox.table")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Klasor = Fso.GetFolder(ThisWorkbook.Path)
    For Each dosyalar In Klasor.Files
    If dosyalar.Name <> ThisWorkbook.Name Then
    If Right(dosyalar.Name, Len(dosyalar.Name) - 2) <> ThisWorkbook.Name Then
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        dosyalar & ";extended properties=""Excel 12.0;imex=1;hdr=no"""
        cat.activeconnection = con
        For a = 2 To Cells(Rows.Count, "J").End(xlUp).Row
        For Each c In Range("P1:R1")
            For Each syf In cat.tables
                syfadi = Replace(Replace(Replace(syf.Name, "'", ""), "$", ""), "#", "")
                If syfadi = Replace(c.Value, ".", "") Then
                sayfa = Replace(syf.Name, "'", "")
                Exit For
                End If
            Next
            sorgu = "select f6 from [" & sayfa & "] Where f1 = '" & Cells(a, "j") & "'"
            rs.Open sorgu, con, 1, 1
            If rs.RecordCount > 0 Then Cells(a, c.Column).CopyFromRecordset rs
            rs.Close
            sorgu = "select f12 from [" & sayfa & "] Where f7 = '" & Cells(a, "j") & "'"
            rs.Open sorgu, con, 1, 1
            If rs.RecordCount > 0 Then Cells(a, c.Column).CopyFromRecordset rs
        rs.Close
        Next c
        Next a
        con.Close
    End If
    End If
    Next
Set rs = Nothing: Set con = Nothing
MsgBox "İşlem tamam", vbInformation + vbMsgBoxRtlReading, "İşlem Tamamlandı."
End Sub
 

Ekli dosyalar

Feyzullah bey merhaba,

Öncelikle bu uğraşlarınız için çok teşekkür ediyorum.Kodları rapor sayfasında uyguladım.Fiyatlar ilgile yerlerine geliyor.Fiyatlar ilgili stokların fiyatları mıdır ? Ayrıca kontrol etmedim.
Fiyatlar ilgili yerlere gelmiş oluyor,Lakin şöyle bir hata alıyorum. Sayfa isimlerinde şöyle bir hata yapmışım. 01.07.2019 olarak isim vermem gerekiyor idi. Bazı sayfalarda 01072019 şeklinde isim vermişim.Hata bundan mı kaynaklıdır acaba ?
Hata resmi ekte ki gibidir.
 

Ekli dosyalar

  • hata.webp
    hata.webp
    55.5 KB · Görüntüleme: 40
Resimdeki hatanın çeşitli birden fazla nedenleri oluyor, bunu dosyanız üzerinden kendim test etmeden bilemem. Hata kodunu da paylaşmış olsa idiniz bir fikir yürütebilirdim belki.
Eklemiş olduğum dosyayı deneyin sorunsuz çalışırsa, dosyalarda aradaki farka bakın.
 
Yatak dosyasının 2. ve 3, sayfalarında veri olmadığı için hata veriyor. Ya o sayfaları silin yada alakasız bir iki kelime yazın sayfalara.

Feyzullah bey,

Dediğiniz gibi yaptım.Boş sayfaları sildim.Zaten boş sayfa tutmam hata.Sorun düzeldi.Boş sayfalar sorun oluşturmuş.
Fiyatlar şuan hatasız ekrana raporlanıyor.Şuan gördüğüm kadarı ile bir hata ile karşılaşmadım.
Allah sizden razı olsun.Zihin açıklığınızı eksik etmesin inşallah.
Saygılarımla.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst