• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Ado ile Kapalı Dosyalardan Tarih Aralığına Göre Veri Alma Kod Yardımı

Believing

Altın Üye
Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
304
Beğeniler
4
Excel Vers. ve Dili
Office Pro 2010 TR 32 Bit
Windows Pro 8.1 TR 64 Bit
#1
Sayın Uzman Arkadaşlar,

Bir klasör içerisinde farklı isimlerdeki kapalı çalışma kitaplarından, açık olan Rapor isimli çalışma kitabına veri transferi yapılıyor. Aşağıdaki kodlar alıntı olup, veri transferi "I2" hücresindeki tarihe göre yapılmaktadır. "H2" ilk tarih "I2" son tarih olacak şekilde iki tarih aralığına göre veri transferi yapmak istiyorum. Bu koşula göre aşağıdaki kodlarda nasıl bir değişiklik yapmalıyım.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

Kod:
DefObj C-D, F, R: DefStr S-T, Y: DefInt I-J
Sub Emre()
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    yol = ThisWorkbook.Path
    Range("A2:G65536").ClearContents
    al = CLng(CDate(Range("I2").Value))
    For Each dosya In fso.getfolder(yol).Files
        If dosya.Name <> ThisWorkbook.Name And _
            Mid(dosya.Name, 2, 1) <> "$" Then
            con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
            dosya & ";extended properties=""Excel 12.0; hdr=no;IMEX=1"""
            t = "select * from [Sayfa1$A15:F65536]"
            t = t & " WHERE clng(cdate([f1]))=" & al & " and not isnull([F1])"
            rs.Open t, con, 1, 1
            oo = rs.RecordCount
            If oo < 1 Then GoTo 10
            Range("A65536").End(3)(2, 1).CopyFromRecordset rs
            Range("G65536").End(3)(2, 1) = Replace(dosya.Name, ".xls", "")
            If oo > 1 Then
            g = Range("G65536").End(3).Row
            Range("G" & g & ":G" & (g + oo) - 1).FillDown
            End If
10          rs.Close
            con.Close
        End If
    Next dosya
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelArsivi.Com"
    i = Empty: j = Empty: s = "": t = "": y = "": Set dosya = Nothing
    Set rs = Nothing: Set fso = Nothing: Set con = Nothing
End Sub
 

Believing

Altın Üye
Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
304
Beğeniler
4
Excel Vers. ve Dili
Office Pro 2010 TR 32 Bit
Windows Pro 8.1 TR 64 Bit
#2
Sayın Uzman Arkadaşlar,

Yukarıdaki kodu iki tarih aralığına göre nasıl revize edebilirim? Benim için çok değerli olan yardımlarınızı rica ediyorum.

Saygılarımla,
Ömer Ali ÜZÜMCÜ


Kod:
al = CLng(CDate(Range("I2").Value))
 

kuvari

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,737
Beğeniler
11
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#3
Merhaba,

Örnek dosyanızı eklerseniz daha net cevaplar alabilirsiniz.
BETWEEN operatörünü araştırın.
 
Üst