• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı Dosyadan Tarihe göre veri almak.

H

Hacı Bayram ÖZKAN

Katılım
24 Şubat 2009
Mesajlar
1,077
Excel Vers. ve Dili
2016
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
Genişletmek için tıkla ...

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.
 
Aşağıdaki kodu deneyebilir misiniz.
Kod: 
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
 
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
 
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.
 
Merhaba,

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

Kod: 
sorgu = "SELECT F2,F4,F13,F3,F8,F9,F13,F13,F13,F13,F10  FROM [İCMAL$] " & _
"where [F10] <> 'ÖDENDİ' and f11 between " & tr1 & " and " & tr2 & " "
 
Eklediğiniz örnek dosya'da denedim çalıştı. Gerçek dosyanızı görmem lazım, her şeyden etkilenebilir.
 
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
 
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
Genişletmek için tıkla ...
 
Merhaba,

C: 
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 & " "
 
Sayın Dost; bu kod "Ölçü ifadesinde veri türü uyuşmazlığı" yazdı ve
rcd.Open sorgu, con, 1, 1
Genişletmek için tıkla ...
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.
 
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.

C: 
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 & " "
 
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
 

Ekli dosyalar

Merhaba,

C: 
'Ö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.
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst