• Merhaba Dostlar,
    yeni forum ile yola devam ediyoruz. Bu büyüklükte bir forum yeni bir sisteme taşımak epey bir yordu bizi. Üstelik bir de yeni XenForo Forum altyapısına geçtik.
    Eminim çok yerde hatalar ve eksikler vardır. Kısa sürede toparlayıp hızlı bir şekilde yolumuza devam edeceğiz.
    Lütfen gördüğünüz eksik ve hataları aşağıdaki bölüme dönderin. Sırasıyla inceleyip yapılabilirliği varsa üzerinde çalışacağım.
    HATA BİLDİRİM BAŞLIĞI
    Forumdaki kullanıcı adınızla ile giriş yapamıyorsanız kullanıcı adınızın sonuna 1 veya 2 gibi rakamlar ekleyerek deneyin.

    Hepimize Hayırlı Olsun!
    Hüseyin
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
294
Beğeniler
2
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
294
Beğeniler
2
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,675
Beğeniler
0
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