Seçmeli Aktar

[Ahmet Sami]

Kıymetli üstadlarım, sizden istediğim yardım, AA2 ye il (KAYIT sayfasında B sütunu) girdiğim zaman ÖDENEN AKTAR butonuna tıkladığım zaman KAYIT sayfasında bulunan ödeme yapanların bilgilerini KAYIT sayfasındaki H sütunun baz alarak LİSTE sayfasına akataracak, ÖDEMEYEN AKTAR butonuna tıkladığım zaman ise ödeme yapmayanların listesini aktaracak.
Ancak bu seçmeli de olması gerekiyor. Yani İL (KAYIT B sütunu) ve TARİH (KAYIT E sütunu) beraber, yalnızca İL ve yalnızca TARİH gibi..

 

[YUSUF44]

Aşağıdaki makroları deneyiniz:

Sub odenen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]=0 and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]=0 and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]=0 and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

Sub odenmeyen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

 

[Ahmet Sami]

Üstadım kodu denedim, ancak ödenen ve ödemeyen olarak aktardığım zaman İL'in tamamını aktarıyor oysaki ödenen veya ödenmeyen gelmesi gerekirdi. Birde verileri aktarırken silip yenisini aktarmıyor, alt alta aktarıyor silip yeniden aktarması gerekiyor.

 

[YUSUF44]

Önceki mesajımdaki kodları güncelledim.

 

[Ahmet Sami]

Çok özür dilerim hocam ama hala olmadı. Aynı hatalar devam ediyor. ANKARA yazıyorum ödenen aktar diyorum. hiç bir işlem yapmıyor ödenmeyen aktar diyorum ANKARA yı aktarıyor. Başka bir il yazdığım zaman her ikisi ile de aktar yapınca hiç bir değişiklik olmuyor.

 

[YUSUF44]

Makronun son haliyle:

AA2 KONYA ve AA4 boşken, ödenmeyen makrosu, ili KONYA ve kalan tutar 3900 olan 7. satırı aktardı.

AA2 KONYA ve AA4 boşken, ödenen makrosu, ili KONYA ve kalan tutarı boş olan 3, 9, 13 ve 19. satırları aktardı.

AA2 boşken ve AA4 2022 iken, ödenmeyen makrosu, kalan tutarı boş olmayan 5, 7, 12, 19 ve 20. satırları aktardı.

AA2 boşken ve AA4 2022 iken, ödenen makrosu, kalan tutarı boş olan 1, 2, 3, 4, 6, 8, 9, 10, 11, 13, 14, 15, 17, 18, 19, 21, 22, 23 ve 24. satırları aktardı.

Bu durumda nesi olmadı ki?

 

[Ahmet Sami]

Hocam, dediklerinizi harfi harfine uyguladım ancak, 7. satırı aktarıyor doğru ama daha sonra diğer illeri aktar yaptığım zaman veya ödenmeyeni aktardığım zaman silip yeniden yazmayıp altına ödeneni aktardığım gibi tek satır olarak aktırıyor ve öyle kalıyor başka hangi ili gerersem gireyim sonuç değişmiyor. Benmi yapamadım bilmiyorum ama size zahmet olmazsa dosyada uygulayıp paylaşabilir misiniz. Yada be derdimi tam anlatamadım.
Şöyleki AA2 ye İL ismi girince ve AA4 e tarih girince ve ödenmeyeni tıklayınca ilgili ilin KAYIT kısmında yer alan H sütununda yer alan KONYA ya ait verilerden 3,9,13,19 satırlarını aktarması gerekiyor. Ödenen'e tıklayınca ise diğerlerini silip 7. satırı aktarması gerekiyor. (Konya yı örnek olarak verdim).

 

[YUSUF44]

Konuyu anlamadım.

KAYIT sayfasındakileri LİSTE sayfasına aktarınca KAYIT sayfasındakilerin silinmesini mi istiyorsunuz?

Yoksa KAYIT sayfasındakileri LİSTE sayfasına aktarmadan önce LİSTE sayfasındaki eski verilerin silinmesini mi istiyorsunuz?

Yoksa başka bir şey mi?

Eski mesajlarınızda bununla ilgili bir talepte bulunmuş muydunuz?

 

[Ahmet Sami]

Evet Liste sayfasına yeni aktarım olunca önceki verilerin Liste sayfasından silinmesi gerekiyor. KAYIT sayfası benim ana girişim yani oradaki bilgiler hep kalacak

 

[YUSUF44]

If sorgusundan önce aşağıdaki satırı ekleyin:

s3.Range("A2:H" & Rows.Count).ClearContents

 

[Ahmet Sami]

Hocam hakkınızı helal edin derdimi tam anlatamıyorum galiba sizi yoruyorum ama, ANASAYFA da AA2 ye KONYA ve AA4 e 2022 girdiğim zaman, ÖDENEN butonuna tıklayınca LİSTE sayfasına sadece 7. satır yani yeşil renkli olan satır aktarılacak, aynı şekilde ki KONYA ve 2022 dururken ÖDENMEYEN butonuna tıklayınca da Mavi renkli satırlar atarılacak yalnız LİSTE sayfasına aktarırken de LİSTE sayfasında ki önceki aktarılmış tüm bilgiler silinip yenisi yazılacak, bir nevi çıktı almak için kullanacağım sayfa gibi düşünün lütfen.

 

[YUSUF44]

Ben if sorgusundan önce eklemenizi istemiştim ama siz if sorgusunun içine eklemişsiniz.

Son açıklamanızda eğer yanlış anlatmadıysanız, Ödenen makrosunun, kalan ödeme sütunu dolu olanları aktarması gerekiyor. Doğru mu? Doğruysa bu saçma olmaz mı?

Aynı şekilde tam tersi yani ödenmeyen makrosunun da kalan sütunu boş olanları aktarması gerekiyor. Kalan sütunu Ödenmesi gereken-ödenen olduğuna göre yani kişi eksik ödeme yaptığına göre eksik ödeme yapanların listelenmesi gerekmez mi?

İlla o dediğiniz gibi olsun istiyorsanız şöyle kullanın:

Sub odenen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

s3.Range("A2:H" & Rows.Count).ClearContents

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR]>0 and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

Sub odenmeyen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

s3.Range("A2:H" & Rows.Count).ClearContents

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR] is null and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR] is null and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where [KALAN MİKTAR] is null and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

 

[Ahmet Sami]

Hocam il dışına çıkmıştım yazamadım. Evet ben size anlatamamışım özür dilerim ama siz anlamış ve kodu ona göre yapmışsınız çok teşekkür ederim. Bende ödenen ve ödenmeyen butonlarının yerini değiştirdim oldu. Yani Ödenene tıklayınca borcu olmayanlar ödenmeyene tıklayınca borcu olanlar geliyor. Gerçekten çok teşekkür ederim size çok zahmet verdim.
Örnek dosyada çalışıyor ancak kendi dosyamda uyguladığım zaman
Set rs = con.Execute(sorgu)
bu kodda hata veriyor.

 

[YUSUF44]

Örnek dosyayla kendi dosyanız arasındaki fark nedir? Sayfa adları ve sütun başlıkları aynıysa ve asıl dosyanız one drive ortamında değilse sıkıntı olmaması gerekir.

 

[Ahmet Sami]

Yusuf bey oldu inşallah ancak atladığım boş KALAN MİKTAR sütunundaki satırları aktarma sırasında aktarma yapmıyordu o sütunda çıkarma işlemi vardı sanırım orayı dolu görüyor ve ondan aktarma yapmıyor onu nasıl çözebilirim

 

[YUSUF44]

Nerdeyse benimle aynı süre üyeliğiniz var. Bunca zaman örnek dosyayla asıl dosyanın aynı yapıda olmasının ne kadar önemli olduğunu anlamış olmanız gerekirdi.

Aşağıdaki gibi deneyin:

Sub odenen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

s3.Range("A2:H" & Rows.Count).ClearContents

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where isnumeric([KALAN MİKTAR]) and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where isnumeric([KALAN MİKTAR]) and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where isnumeric([KALAN MİKTAR]) and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

Sub odenmeyen()
Set s1 = Sheets("ANASAYFA")
Set s2 = Sheets("KAYIT")
Set s3 = Sheets("LİSTE")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes;imex=1"""

s3.Range("A2:H" & Rows.Count).ClearContents

If s1.[AA2] <> "" And s1.[AA4] = "" Then
    sorgu = "select * from [KAYIT$] where not isnumeric([KALAN MİKTAR]) and İl='" & s1.[AA2] & "'"
ElseIf s1.[AA2] = "" And s1.[AA4] <> "" Then
    sorgu = "select * from [KAYIT$] where not isnumeric([KALAN MİKTAR]) and TARİH=" & s1.[AA4]
Else
    sorgu = "select * from [KAYIT$] where not isnumeric([KALAN MİKTAR]) and İl='" & s1.[AA2] & "' and TARİH=" & s1.[AA4]
End If
Set rs = con.Execute(sorgu)
yeni = s3.Cells(Rows.Count, "B").End(3).Row + 1

s3.Cells(yeni, "A").CopyFromRecordset rs

End Sub

 

[Ahmet Sami]

Çok haklısınız üstadım, normalde böyle bir şeyi yapmam ama bu biraz aceleye geldi hemen yapmak istedim sanırım ondan kaynaklandı ve aslında yine olması gereken zamanda oldu yani vakit gelmeden acele de etsek olmayınca olmuyor kusuruma bakmayın sizi çok uğraştırdım. Zahmetiniz için çok teşekkür ederim.