Tarih ve Başka Koşula Göre Bir Verinin Değerini Getirme

[Erkan Yılmaz]

Merhaba Arkadaşlar,

Sevgili bzace ve Ömer bey sayesinde istediğim tabloyu belli bir yere getirdim. O arkadaşlara ayrı ayrı çok teşekkür ediyorum. Ancak bazı eklemeler yapmak istiyorum.

Tarih ve bir başka koşula göre veriyi sayısal olarak toplamasını istiyorum.

Daha detaylı istediğimi anlatacak olursam;
Hareket Girişi diye bir tablom var Devamlı veri giriyorum. Satırda veri giriyorken hesap adına geldiğim zaman hangi hesapta işlem yapıyorsam işlem yaptığım tarihe kadar toplamını vermesini istiyorum.

Amacım hesap hareketi girişi yaparken o hesabında bakiyesini göreyim istiyorum.

Örnek tabloyu gönderiyorum. İstediğimi daha iyi anlayacağınızı düşünüyorum. Tabi yapılabilecekse bilmiyorum. Belki de makro kod gerektirebilir.

Şimdiden teşekkür ediyorum.

KİŞİSEL FİNANS DURUMU - örnek.xlsx - 382 KB

Daha basit olacaksa şöylede olabilir Hareket Girişi sayfasında en üstte HESAP BAKİYE kısmını tek hücre değil sol taraftaki mantıkla borç - alacak - bakiye şeklinde de yapabiliriz.

Bahsettiğim konu örnek dosya da mevcuttur.

KİŞİSEL FİNANS DURUMU - örnek - 2.xlsx - 381 KB

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B6:I1000")) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)
[E3] = WorksheetFunction.SumIf(Range("E6:E" & son), Cells(Target.Row, "E"), Range("I6:I" & son))
End Sub

 

[Erkan Yılmaz]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B6:I1000")) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)
[E3] = WorksheetFunction.SumIf(Range("E6:E" & son), Cells(Target.Row, "E"), Range("I6:I" & son))
End Sub

Sevgilli, YUSUF44 bey öncelikle çok teşekkür ediyorum.

Orjinal dosyamda denedim ama bakiye değil toplam veriyor mesela ayın 5 inde kasam sıfır. 5 inde üzerine geldiğim zaman 0 vermesi gerekirken 688 tl veriyor hem borcu hemde alacağı topluyor sanırım.

İkinci gönderdiğim dosya için yapabilirsek daha iyi olacak sanki. Tarih aralığı yok sanırım kodlarda

 

[YUSUF44]

Aşağıdaki gibi mi?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B6:I1000")) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)
[B3] = WorksheetFunction.SumIfs(Range("I6:I" & son), Range("E6:E" & son), Cells(Target.Row, "E"), _
        Range("H6:H" & son), "Borç")
[D3] = WorksheetFunction.SumIfs(Range("I6:I" & son), Range("E6:E" & son), Cells(Target.Row, "E"), _
        Range("H6:H" & son), "Alacak")
[E3] = [B3] - [D3]
End Sub

 

[Erkan Yılmaz]

Aşağıdaki gibi mi?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("B6:I1000")) Is Nothing Then Exit Sub
son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)
[B3] = WorksheetFunction.SumIfs(Range("I6:I" & son), Range("E6:E" & son), Cells(Target.Row, "E"), _
        Range("H6:H" & son), "Borç")
[D3] = WorksheetFunction.SumIfs(Range("I6:I" & son), Range("E6:E" & son), Cells(Target.Row, "E"), _
        Range("H6:H" & son), "Alacak")
[E3] = [B3] - [D3]
End Sub

Yusuf Bey, evet bunun gibi ama herhangi bir tarihe geldiğim zaman o zamanın bakiyesini vermesi gerekiyor. Yani tamam hesap sıfırlandı belli bir tarihte ama önceki tarihlerde o hesaba geldiğim zaman o an ki bakiye çıksın istiyorum.

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod'u dener misiniz? (Borç - Alacak - BAKİYE ayrı ayrı yazılıyor)

[FONT="Trebuchet MS"][SIZE="2"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If Target.Row > [E65536].End(3).Row Or Target.Column <> 5 Then
    Cells(3, 5) = ""
    Exit Sub
End If
Range("J6").Formula = "=SUM(IF($E$5:E5=E6,IF($C$5:C5=C6,IF($H$5:H5=""Borç"",$I$5:I5))))": Range("J6").FormulaArray = Range("J6").Formula
Range("K6").Formula = "=SUM(IF($E$5:E5=E6,IF($C$5:C5=C6,IF($H$5:H5=""Alacak"",$I$5:I5))))": Range("K6").FormulaArray = Range("K6").Formula
    Range("J6:K6").Copy Range("J" & Target.Row & ":K" & Target.Row)
    Range("J" & Target.Row & ":K" & Target.Row).Calculate: Application.CutCopyMode = False
[COLOR="Red"]Cells(3, 2)[/COLOR] = Cells(Target.Row, 10): [COLOR="red"]Cells(3, 4)[/COLOR] = Cells(Target.Row, 11): [COLOR="red"]Cells(3, 5)[/COLOR] = Cells(3, 2) - Cells(3, 4)
Range("J:K").ClearContents
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B][/SIZE][/FONT]

 

[Erkan Yılmaz]

Merhaba.
Biraz acemice olabilir ama aşağıdaki kod'u dener misiniz?
Son satır numarasını asıl dosyanıza göre düzeltirsiniz.

[FONT="Trebuchet MS"][SIZE="2"][B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False
If ActiveCell.Row > [E65536].End(3).Row Or ActiveCell.Column <> 5 Then
    Cells(3, 5) = ""
    Exit Sub
End If
If Intersect(Target, Range("E6:E" & [E65536].End(3).Row)) Is Nothing Then Exit Sub
    Cells(2, 10) = Cells(ActiveCell.Row, 3): Cells(2, 11) = Cells(ActiveCell.Row, 5)
        borç = Evaluate("=SUM(IF(E6:E1000=K2,IF(C6:C[COLOR="Red"]1000[/COLOR]=J2,IF(H6:H[COLOR="red"]1000[/COLOR]=""Borç"",I6:I[COLOR="red"]1000[/COLOR]))))")
        alacak = Evaluate("=SUM(IF(E6:E1000=K2,IF(C6:C[COLOR="red"]1000[/COLOR]=J2,IF(H6:H[COLOR="red"]1000[/COLOR]=""Alacak"",I6:I[COLOR="red"]1000[/COLOR]))))")
        Range("J2:K2").ClearContents
    Cells(3, 5) = borç - alacak
Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
[B]End Sub[/B][/SIZE][/FONT]

Sevgili Ömer BARAN bey üzülerek belirtmek isterim ki malesef olmadı.

 

[YUSUF44]

Herhangi bir tarihten kastınız seçilen satıra (dahil) kadar olan toplam ise son değişkenini son = target.row olarak değiştirip dener misiniz?

 

[Erkan Yılmaz]

Yusuf Beyin, son gönderdiği kod tamam dı ama direk toplamlarını veriyor.

Şimdi ki göndereceğim dosyada tam olarak istediğimi daha net anlatmışımdır umarım.

KİŞİSEL FİNANS DURUMU - örnek - 2.xlsx - 382 KB

 

[Erkan Yılmaz]

Herhangi bir tarihten kastınız seçilen satıra (dahil) kadar olan toplam ise son değişkenini son = target.row olarak değiştirip dener misiniz?

Evet aynen öyle yusuf bey seçilen satıra kadar olan toplam. Son değişkeni hangisi oluyor Yusuf Bey?

 

[Ömer BARAN]

Önceki cevabımda yer alan KOD'u yeniledim.
Yeni halini test ediniz.

 

[YUSUF44]

Evet aynen öyle yusuf bey seçilen satıra kadar olan toplam. Son değişkeni hangisi oluyor Yusuf Bey?

son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)

satırını

son = Target.Row

olarak değiştirin.

 

[Erkan Yılmaz]

Önceki cevabımda yer alan KOD'u yeniledim.
Yeni halini test ediniz.

Sevgili Ömer BARAN bey,


Emekleriniz ve yardımlarınız için çok teşekkür ediyorum ama istediğim sonuca ulaşamıyorum. Size orjinal dosyamı gönderiyorum verilerimin olduğu belki bunun üzerinde düzeltebilirsiniz.

Birde Borç - Alacak kısmınıda yapabilirsek daha iyi olur. HESAP Bakiyesi kısmınıda çıkarma mantığı ile yapabiliriz.

 

[Erkan Yılmaz]

son = WorksheetFunction.Max(Cells(Rows.Count, "B").End(3).Row, 6)

satırını

son = Target.Row

olarak değiştirin.

Sevgili YUSUF44 Bey,

Sanırım oldu. Ellerinize sağlık. Teşekkür ediyorum. Bir test edeyim bir sorun çıkarsa geri dönüş yaparım.

 

[Ömer BARAN]

Merhaba.
Orijinal dosyayı eklediğiniz mesajda dosya yok, sanırım eki kaldırdınız.
Düzenlediğim son KOD sadece BAKİYE kısmı içindi.
Borç-Alacak-Bakiye, ayrımı olacak şekilde ilk cevabımdaki KOD'da değişiklik yaptım.
Kontrol ediniz.

 

[Erkan Yılmaz]

Merhaba.
Orijinal dosyayı eklediğiniz mesajda dosya yok, sanırım eki kaldırdınız.
Düzenlediğim son KOD sadece BAKİYE kısmı içindi.
Borç-Alacak-Bakiye, ayrımı olacak şekilde ilk cevabımdaki KOD'da değişiklik yaptım.
Kontrol ediniz.

Sevgili Ömer BARAN,

Çok Teşekkür Ediyorum yardımlarınız için. Sorunu çözdüm şu anda.

 

[Ömer BARAN]

Sevgili Ömer BARAN,

Çok Teşekkür Ediyorum yardımlarınız için. Sorunu çözdüm şu anda.

Sorun çözülmüşse emek boşa gitmemiş demektir.
İyi günler dilerim.