kapalı dosyadan iki tarih arası veri almak

[tahsinanarat]

Sub Veri_Aktar()
Sheets("Takip_Listesi").Select
Range("A6:am65000").ClearContents
Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
"C:\PERSONEL\PERSONEL_DATA.xlsm" & ";extended properties=""excel 12.0;hdr=no;imex=1"""

sorgu = "Select f1,f2,f10,f11,f14,f13,f18,f19,f20,f31,f32,f34,f35,f36,f37,f38 from [PERSONEL$A2:Am65000]"

rs.Open sorgu, con, 1, 1
Range("a6").CopyFromRecordset rs
rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: sorgu = Empty
Range("b3").Select
End Sub

Yukarıdaki kod ile kapalı olan (C:\PERSONEL\PERSONEL_DATA.xlsm) dosyanın PERSONEL sayfasının belirttiğim sütunlarındaki
(sorgu = "Select f1,f2,f10,f11,f14,f13,f18,f19,f20,f31,f32,f34,f35,f36,f37,f38 from [PERSONEL$A2:Am65000]") verileri çekebiliyorum, buraya kadar herhangi bir sıkıntı yok.

Benim istediğim ise aynı sütunların AK sütununda bulunan tarihlerden başlangıç ve bitiş tarihi belirleyip saadece iki tarih arasındaki verileri getirmek.
Yukarıda belirttiğim kodda kapalı olan PERSONEL sayfasının AK sutundaki iki tarih arasını getirebilmem için nasıl bir değişiklik yapmalıyım. Ado kodlarından anlayan hocalarımın desteklerini bekliyorum.
Saygılarımla

 

[acar6783]

WHERE TARİH BETWEEN '" & ilktarih & "'  and '" & sontarih & "'"

Kodlarını ekleyin

 

[tahsinanarat]

Sn. acar6783 ; bu verdiğiniz kodu benim kodların neresine yerleştireceğim, tarihleri hücreden (örn. G3 , H3 hücrelerine başlangıç ve bitiş tarihini gireceğim) aldırılması, ayrıca kapalı dosyadaki AK sütunundaki tarih sütunundan okumasını nasıl sağlayacağım, ADO kodları hakkında bilgim yok.

 

[acar6783]

ilktarih = CLng(CDate(Range("G3").Value))
sontarih = CLng(CDate(rRange("H3").Value))
sorgu = "Select f1,f2,f10,f11,f14,f13,f18,f19,f20,f31,f32,f34,f35,f36,f37,f38 from [PERSONEL$] WHERE CLng(CDate(f37)) BETWEEN '" & ilktarih & "'  and '" & sontarih & "'"

Bu şekildebir deneyiniz

 

[tahsinanarat]

Sn. acar6783 ilginiz için çok teşekkür ediyorum;

Sub Veri_Aktar()
Sheets("Takip_Listesi").Select
Range("A6:az65000").ClearContents
Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
"C:\PERSONEL\PERSONEL_DATA.xlsm" & ";extended properties=""excel 12.0;hdr=no;imex=1"""

ilktarih = CLng(CDate(Range("G3").Value))
sontarih = CLng(CDate(Range("H3").Value))
sorgu = "Select f1,f2,f10,f11,f14,f13,f18,f19,f20,f31,f32,f34,f35,f36,f37,f38 from [PERSONEL$A2:AZ65536] WHERE CLng(CDate(f37)) BETWEEN '" & ilktarih & "'  and '" & sontarih & "'"

rs.Open sorgu, con, 1, 1
Range("a6").CopyFromRecordset rs
rs.Close: con.Close
Set con = Nothing: Set rs = Nothing: sorgu = Empty
 Range("b3").Select
 End Sub

Bu şekilde denedim, ancak; Ölçüt ifadesinde veri türü uyuşmazlığı. diye bir hata veriyor.

 

[acar6783]

g(CDate(f37))

Raporda tarih 37. sütunda değil m?

 

[tahsinanarat]

Kontrol ettim doğrudur AK sutunu yani 37. sutun.

 

[acar6783]

Dosyanızı yükler misiniz?

 

[tahsinanarat]

Dosyaları gönderiyorum.

 

[acar6783]

Buyrun. Dosya ektedir.
İlk satırı boş bıraktığınız için hata alıyosunuz. Koşula ekleme yaptım Ak1 hücresine de değer girdim

 

[tahsinanarat]

Sn. acar6783 Orijinal dosyama uyguladığımda hatayı alıyorum, AK1 hücresine başlığık girdiğim halde, sizin yüklediğiniz şekliyle dataları alıyor ve düzgün çalışıyor, aynı dosyaya gerçek verilerimi kopyala yapıştır yaptığımda yine aynı hatayı alıyorum. Nasıl olduğunu da anlayamadım.

 

[acar6783]

Benim de anlamam için dosyayı girmem lazım

 

[tahsinanarat]

Sn. acar6783 Beyin yaptığı kodlar ile soruncu hallettim, kendisine buradan bir kez daha teşekkür ederim.
Çalışma kitabına Eksayfa adlı sayfa eklenmiştir.

Sub Veri_Aktar()
scrfalse
Sheets("Takip_Listesi").Select
Range("A6:az65000").ClearContents
Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
"C:\PERSONEL\PERSONEL_DATA.xlsm" & ";extended properties=""excel 12.0;hdr=no;imex=1"""
Sheets("Eksayfa").Cells.ClearContents
sorgu = "Select f1,f2,f4,f10,f11,f14,f13,f18,f19,f20,f31,f32,f34,f35,f36,f37,F38 from [PERSONEL$] " & _
"WHERE NOT isnull(f37) and f37<> '" & "" & " ' "


rs.Open sorgu, con, 1, 3
Sheets("Eksayfa").Range("a1").CopyFromRecordset rs
rs.Close: con.Close

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=no;imex=1"""

ilktarih = CLng(CDate(Range("G3").Value))
sontarih = CLng(CDate(Range("H3").Value))
sorgu = "Select f1,f2,f3,f4,f5,f6,f7,f8*1,f9*1,f10,f11,f12,f13,f14,f15,f16,F17 from [EkSayfa$] " & _
"WHERE CLng(CDate(f16)) BETWEEN '" & ilktarih & "' and '" & sontarih & "'"
rs.Open sorgu, con, 1, 3

Range("a6").CopyFromRecordset rs

rs.Close: con.Close

Set con = Nothing: Set rs = Nothing: sorgu = Empty




Range("b3").Select
scrtrue
End Sub
Sub scrfalse()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

End Sub
Sub scrtrue()
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub