Kapalı Dosyadan Tarihe göre veri almak.

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar: Bu adreste bulunan "E:\Belgelerim\Ödemeler\Geçici Görev Yolluğu Ödemesi\KAPALI.xls" kapalı dosyamdan ÖDENMEYECEK olanları aşağıdaki kodlarla verileri alıyorum.

Sub AAA_ÖDENMEYENLERİ_GETİR()
'İcmal Sayfasının ÖDENDİ satırlarını almıyor.

Dim s1 As Worksheet
Dim con, rcd
Dim x As Long, dosyayolu As String
Set s1 = Sheets("İZİNLER")
dosyayolu = "E:\Belgelerim\Ödemeler\Geçici Görev Yolluğu Ödemesi\KAPALI.xls"
Set con = CreateObject("Adodb.Connection")
Set rcd = CreateObject("adodb.recordset")
s1.Range("O2:Z" & Rows.Count) = Empty
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"

rcd.Open "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10 FROM [İCMAL$] where [F10] <> '" & "ÖDENDİ" & "'", con, 1, 1
x = s1.Cells(Rows.Count, "P").End(3).Row + 1
s1.Range("P" & x).CopyFromRecordset rcd
s1.Range("P" & x & ":Z" & x).Delete Shift:=xlUp
x = s1.Cells(Rows.Count, "P").End(3).Row
s1.[O2] = "1"
s1.[O2].AutoFill Destination:=Range("O2:O" & x), Type:=xlFillSeries
rcd.Close
Set rcd = Nothing
Set con = Nothing


End Sub

Benim isteğim DENEME dosyasının Puantaj Sayfasındaki AS3 hücresindeki tarihe göre bir aylık olanları getirmesini istiyorum, bu kodla tamamı geliyor.

 

[Hacı Bayram ÖZKAN]

Üyeliğim bitmiş galiba kaydımı yeniledim, dosyaları yükleyeceğim.

 

[Hacı Bayram ÖZKAN]

İndir KAPALI

Dosyayı indir KAPALI

dosya.co

İndir DENEME

Dosyayı indir DENEME

dosya.co

Merhaba arkadaşlar üyeliğim aktif olmadı dosyaları buraya attım, bakarsanız sevinirim. Teşekkürler.

 

[Erdem Akdemir]

Aşağıdaki kodu deneyebilir misiniz.

Sub AAA_ÖDENMEYENLERİ_GETİR()
'İcmal Sayfasının ÖDENDİ satırlarını almıyor.

Dim s1 As Worksheet
Dim con, rcd
Dim x As Long, dosyayolu As String
Set s1 = Sheets("İZİNLER")
dosyayolu = "E:\Belgelerim\Ödemeler\Geçici Görev Yolluğu Ödemesi\KAPALI.xls"

Set con = CreateObject("Adodb.Connection")
Set rcd = CreateObject("adodb.recordset")
s1.Range("O2:Z" & Rows.Count) = Empty
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"

tr1 = CLng(Sheets("PUANTAJ").Range("AS3"))
tr2 = CLng(DateSerial(Year(tr1), Month(tr1) + 1, 1))

sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] <> 'ÖDENDİ' and f11 between " & tr1 & " and " & tr2 & " "

'sorgu = "SELECT F11 FROM [İCMAL$] where F10 <> 'ÖDENDİ' and f11 = 42755 "

rcd.Open sorgu, con, 1, 1
'aa = rcd.getrows

x = s1.Cells(Rows.Count, "P").End(3).Row + 1
s1.Range("P" & x).CopyFromRecordset rcd
's1.Range("P" & x & ":Z" & x).Delete Shift:=xlUp
x = s1.Cells(Rows.Count, "P").End(3).Row
's1.[O2] = "1"
's1.[O2].AutoFill Destination:=Range("O2:O" & x), Type:=xlFillSeries
rcd.Close
Set rcd = Nothing
Set con = Nothing


End Sub

 

[Hacı Bayram ÖZKAN]

Merhaba Erdem abi şuan deneme imkanım yok Pazartesi günü iş yerinde deneyeceğim ayrıca bilgi vereceğim iyi akşamlar Allah rahatlık versin

 

[Hacı Bayram ÖZKAN]

Merhaba Erdem Bey; Kod çalışmadı efendim, yani sonuç alamadım,
'sorgu = "SELECT F11 FROM [İCMAL$] where F10 <> 'ÖDENDİ' and f11 = 42755 "

rcd.Open sorgu, con, 1, 1
'aa = rcd.getrows

x = s1.Cells(Rows.Count, "P").End(3).Row + 1
s1.Range("P" & x).CopyFromRecordset rcd
's1.Range("P" & x & ":Z" & x).Delete Shift:=xlUp
x = s1.Cells(Rows.Count, "P").End(3).Row
's1.[O2] = "1"
's1.[O2].AutoFill Destination:=Range("O2:O" & x), Type:=xlFillSeries

Buradaki çentikleri de kaldırdım yine olmadı. Bakarsan sevinirim.

 

[Erdem Akdemir]

Merhaba,

Gerçek sorgu aşağıdaki gibi olmalı.

sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] <> 'ÖDENDİ' and f11 between " & tr1 & " and " & tr2 & " "

 

[Hacı Bayram ÖZKAN]

Merhaba abim; aktif sorgu, 4 nolu mesajda onu aynen aldım, ama yine olmuyor.

 

[Erdem Akdemir]

Eklediğiniz örnek dosya'da denedim çalıştı. Gerçek dosyanızı görmem lazım, her şeyden etkilenebilir.

 

[Hacı Bayram ÖZKAN]

Meail verebilir misiniz Gerçek veriler var

 

[Hacı Bayram ÖZKAN]

Merhaba abim hatayı buldum;


sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10 FROM [İCMAL$] " & _
"where [F10] <> 'ÖDENDİ' and f11 between " & tr1 & " and " & tr2 & " "


Burdaki F11 değil F9 olacak bunu değiştirince yaptı teşekkür ederim. Zahmet verdim dua ile kal

 

[Hacı Bayram ÖZKAN]

merhaba arkadaşlar;
Aşağıdaki kodu kodu sağolsun Erdem AKDEMİR abimiz Erdem idi; bu ürünü kullanıyor, bu kodla birlikte yanı aynısı ile ÖDENEK BEKLENİYOR ekindekileri bana getiriyor. Bunu Kapalı dosyamın J kolonunda bulunan ÖDENMEYECEK MAA. ÖDENECEK uygulamasını getirmesini istiyorum. Kodu nasıl düzeltilir.

Sub A_ÖDENMEYENLERİ_GETİR()
Dim s1 As Worksheet
Dim con, rcd
Dim x As Long, dosyayolu As String
Set s1 = Sheets("İZİNLER")
dosyayolu = "D:\Belgelerim\Ödemeler\Geçici Görev Yolluğu Ödemesi\GEÇİCİ GÖREV YOLLUĞU LİSTESİ 2017.xls"

Set con = CreateObject("Adodb.Connection")
Set rcd = CreateObject("adodb.recordset")
s1.Range("O2:Z" & Rows.Count) = Empty
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
dosyayolu & ";Extended Properties = ""Excel 12.0 Macro;HDR=NO"";"

tr1 = CLng(Sheets("PUANTAJ").Range("AS3"))
tr2 = CLng(DateSerial(Year(tr1), Month(tr1) + 1, 1))

sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10 FROM [İCMAL$] " & _
"where [F10] <> 'ÖDENEK BEKLENİYOR' and F9 between " & tr1 & " and " & tr2 & " " 'hangisini yazarsak onları almıyor. Burası ne yazarsam onu getirmesini istiyorum, bu şekilde bir sorgu kodu istiyorum saygılarımla...

'sorgu = "SELECT F11 FROM [İCMAL$] where F10 <> 'ÖDENDİ' and f11 = 42755 "

rcd.Open sorgu, con, 1, 1
'aa = rcd.getrows

x = s1.Cells(Rows.Count, "P").End(3).Row + 1
s1.Range("P" & x).CopyFromRecordset rcd
's1.Range("P" & x & ":Z" & x).Delete Shift:=xlUp
x = s1.Cells(Rows.Count, "P").End(3).Row
s1.[O2] = "1"
s1.[O2].AutoFill Destination:=Range("O2:O" & x), Type:=xlFillSeries
rcd.Close

Range("P:Z").EntireColumn.AutoFit

Set rcd = Nothing
Set con = Nothing

End Sub

 

[dost]

Merhaba,

sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where ([F10] = 'ÖDENMEYECEK MAA.' or [F10] = 'ÖDENECEK') and f11 between " & tr1 & " and " & tr2 & " "

 

[Hacı Bayram ÖZKAN]

Sayın Dost; bu kod "Ölçü ifadesinde veri türü uyuşmazlığı" yazdı ve

rcd.Open sorgu, con, 1, 1

bu satır sarı yandı.

Abim birde iki kalem değil, sadece bir kalem gelecek o da "ÖDENMEYECEK MAAŞ ÖDENECEK" J Kolonundaki bu ifadeyi yazan verilerin gelmesini istiyorum. Yani Sadece bu cümle . için olacak. TEŞEKKÜR EDERİM.

 

[dost]

Sayın Hacı Bayram ÖZKAN,

1- Dosyanız silindiği için deneme yapılamıyor. Altın üyeliğiniz var. Bu yüzden dosyanızı yeniden yükleyebilirsiniz.

2- Nacizane tavsiyem: Sorgu komutunda SQL ile kapalı dosyadan verileri çağırıyorsunuz. Bu yüzden ben olsam SQL dilini internette araştırıp SELECT komutunu ve WHERE kalıbını öğrenmeye çalışırdım.

İyi günler.

sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] = 'ÖDENMEYECEK MAAŞ ÖDENECEK' and f11 between " & tr1 & " and " & tr2 & " "

 

[Hacı Bayram ÖZKAN]

Merhaba Sayın Dost: Dosyaları yükledim bulduğum kod çalışıyor ama ÖDENDİ leride getiriyor, benim isteğim sadece ÖDENMEYECEK MAAŞ ÖDENECEK
bunları getirsin. Dosyayı çalışan kod ile yükledim efendim. AÇIK olan dosya 9 EYLÜL 2021 Kapalı olan dosya GEÇİCİ GÖREV YOLLUĞU LİSTESİ 2017

 

[dost]

Merhaba,

'ÖDENMEYECEK MAAŞ ÖDENECEK' olanları getirir.
sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] = 'ÖDENMEYECEK MAAŞ ÖDENECEK' and F9 between " & tr1 & " and " & tr2 & " "
    
'ÖDENMEYECEK' ile başlayanları getirir.
sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] LIKE 'ÖDENMEYECEK%' and F9 between " & tr1 & " and " & tr2 & " "
    
'ÖDENDİ' olanları getirir.
sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] = 'ÖDENDİ' and F9 between " & tr1 & " and " & tr2 & " "
    
'ÖDENDİ' ile bitenleri getirir.
sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] LIKE '%ÖDENDİ' and F9 between " & tr1 & " and " & tr2 & " "
    
vs vs.

 

[Hacı Bayram ÖZKAN]

Teşekkür ederim sayın Dost çalıştı çok teşekkür ederim, alternatiflerinde yazmış sınız. Onun için ayrıca teşekkür ederim. Ellerine sağlık