Bakiyesi Sıfır Olan Borçları Aktar

[emnozdemir]

Ekli dosyada da anlattığım üzere bakiyesi "0" olan borçları yani ödenenleri yandaki tabloya aktarmak istiyorum.

 

[Mustafa MUTLU]

İşini Görür
100. cü satıra kadar kayıtları sıralar.

 

[Orion1]

Dosyanız ektedir.

Sub aktar_59()
Application.ScreenUpdating = False
Range("I4:K65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
Range("A3:E" & sat).AutoFilter
Range("A4:E" & sat).Interior.ColorIndex = 15
Range("A3:E" & sat).AutoFilter field:=5, Criteria1:=0
Range("A4:B" & sat).SpecialCells(xlCellTypeVisible).Copy Range("I4")
Range("D4:D" & sat).SpecialCells(xlCellTypeVisible).Copy Range("K4")
Range("A4:E" & sat).Interior.Color = vbYellow
Range("A3:E" & sat).AutoFilter
Application.ScreenUpdating = True
End Sub

 

[emnozdemir]

İginize Teşekkür ederim, ama bu alternatiflerden ziyade Formülle yapmak istiyorum bunu. Eklediğim dosyada belirttiğim şekilde borçlar ödendikçe yani bakiye sıfırlandıkça ("0") yandaki tabloya ödenenlerin bilgileri gelsin.

 

[muygun]

Merhaba;
Formülle çözüm ekte.
İyi çalışmalar.

 

[emnozdemir]

Çok Teşekkür ederim Sayın muygun...

 

[polis-53]

bAKİYESİ SIFIR OLANLARI AKTAR VE RENKLENDİR

Merhaba Orion1 arkadaşım bakiyesi sıfır olanları aktarda bende bir şey isteyebilirmiyim bakiyesi sıfır olanlar aktarıldığında sıfır aktarılanlar renklensin

 

[emnozdemir]

İlgili Formülleri Ekteki dosyama uyarlamaya çalıştım ama bir türlü beceremedim. Yardımcı olur musunuz ?

 

[İhsan Tank]

İlgili Formülleri Ekteki dosyama uyarlamaya çalıştım ama bir türlü beceremedim. Yardımcı olur musunuz ?

Merhaba
Ödemeler Tablosu sekmesinin A3 hücresine

=EĞER(SATIRSAY(A$3:A3)>EĞERSAY('Borçlar Tablosu'!$H$3:$H$1000;0);"";İNDİS(
'Borçlar Tablosu'!A$3:A$1000;KÜÇÜK(EĞER('Borçlar Tablosu'!$H$3:$H$1000=0;SATIR(
'Borçlar Tablosu'!$H$3:$H$1000)-SATIR('Borçlar Tablosu'!$H$3)+1);SATIRSAY(A$3:A3
))))

Formülünü yazın ve dizi formülüne çevirin.

Dizi Formülü Formül Hücreye Girildikten Sonra Enter Tuşuna Basmadan Ctrl+Shift+Enter Tuş Kombinasyonu İle Aktif Olmaktadır. Formülün Başında Ve Sonunda { } Bu İşaretler Çıkar Elle Eklediğiniz Takdirde Formül Hata Verir.

Formülde 1000 satır baz alınmıştır.

1000 satır'ı değiştirmek için ctrl+h yapın aranan değere $1000 yeni değere $10000 yazın ve tümünü değiştir deyin.
$10000 olan yeri kendinize göre ayarlayınız.

Yardımcı hücreye gerek yoktur.

 

[Orion1]

Merhaba Orion1 arkadaşım bakiyesi sıfır olanları aktarda bende bir şey isteyebilirmiyim bakiyesi sıfır olanlar aktarıldığında sıfır aktarılanlar renklensin

Dosyada istediğiniz değişikliği yaptım.
3 numaralı mesajdan indirebilirsiniz.

 

[Orion1]

İginize Teşekkür ederim, ama bu alternatiflerden ziyade Formülle yapmak istiyorum bunu. Eklediğim dosyada belirttiğim şekilde borçlar ödendikçe yani bakiye sıfırlandıkça ("0") yandaki tabloya ödenenlerin bilgileri gelsin.

Formülle yapmak istiyorsanız lütfen sorunuzu fonksiyonlar bölümünde sorunuz.
Bu durumda bizde boş yere kürek çekmemiş oluruz.

 

[zodiak]

sayın hocalarım vermiş olduğunz kodlar ve formüller okadar çok işime yarıyorki anlatamam sizlerle ve bu blogla tanıştığıma öyle memnununki ikinci adresim oldu sanki burası çokkkk teşekkür ederim şahsım adına

 

[zodiak]

sıfırdan farkı olmasını istiyorsanız modülün kodundaki 7. satırın sonuna bıkın

Sub aktar_59()
Application.ScreenUpdating = False
Range("I4:K65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
Range("A3:E" & sat).AutoFilter
Range("A4:E" & sat).Interior.ColorIndex = 15
Range("A3:E" & sat).AutoFilter field:=5, Criteria1:=">0"
Range("A4:B" & sat).SpecialCells(xlCellTypeVisible).Copy Range("I4")
Range("e4:e" & sat).SpecialCells(xlCellTypeVisible).Copy Range("K4")
Range("d4:d" & sat).SpecialCells(xlCellTypeVisible).Copy Range("l4")
Range("c4:c" & sat).SpecialCells(xlCellTypeVisible).Copy Range("m4")
Range("A4:E" & sat).Interior.Color = vbYellow
Range("A3:E" & sat).AutoFilter
Application.ScreenUpdating = True
End Sub

 

[zodiak]

birde bu koda aynı kitabın başka bir sayfasından veri alımı nasıl yapılabilr 3. sayfadaki verilerden değeri sıfırdan farklı olan bilgiler mesela
oriın hocamın verdiği örnekte mesela kaynak veriler bir başka sayfada yada kapalı bir kitapta olsaydı bunu nasıl yapardık

http://www.excel.web.tr/attachment.php?attachmentid=117338&d=1317730876 orion hocamın verdiği örnek

 

[zodiak]

başka sayfa başka kitap yardım

anlatmaya çalıştım bakarsanız sevinirim örnek dosya ekte

 

[zodiak]

yokmu bir çaresi

 

[İhsan Tank]

yokmu bir çaresi

Ben sizin soruya cevap verdiniz diye düşünmüştüm ondan bir hamlede bulunmamıştım.
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub sıfır_aktar_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("Sayfa1")
Set mavi = Sheets("Sayfa2")
trabzonspor = MsgBox("Bakiyesi Sıfır Olanları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
bordo.Range("A:E").ClearContents
mavi.Range("A2:E3").Copy Destination:=bordo. _
Range("A2")
kaplan = 4
For ts = 4 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
If mavi.Cells(ts, "E") = 0 Then
mavi.Range("A" & ts & ":E" & ts).Copy Destination:=bordo _
.Range("A" & kaplan)
kaplan = kaplan + 1
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Bakiyesi Sıfır Olanları Aktardım", , "Bitiş"
End Sub

 

[zodiak]

excell i zaten severdim sayenizde dahada çok sevmeye başladım... sizlerden öğreneceğim nekedar çok şey olduğunu burdaki örnek ve kodları inceledikçe dahada iyi anlıyorum ellerinze sağlık

 

[İhsan Tank]

excell i zaten severdim sayenizde dahada çok sevmeye başladım... sizlerden öğreneceğim nekedar çok şey olduğunu burdaki örnek ve kodları inceledikçe dahada iyi anlıyorum ellerinze sağlık

Kolay Gelsin
:keyif:

 

[emnozdemir]

"Borçlar Tabosu" sayfasındaki Bakiyesi sıfır olanları Formül yardımıyla "Ödemeler Tablosu" sayfasına aktarırırken, "ödeme tarihine göre" sıralı olarak (eskiden yeniye) aktarılmasını sağlayabilirmiyiz?