Sütunda listeye göre toplamlar

[kelkitli]

Selamlar,
Ekteki dosyada veri sayfası F12:F aralığında işlemler yazılı.
Liste isimli sayfada C sütunundaki yazılı ileme ait veri sayfasında kaç tane kayıt varsa liste F1 deki aya göre gelir ve gider toplamlarını D ve E sütunlarına yazabilirmiyiz.
Saygılar.

 

[Vedat Özer]

Selamlar,

Formül olarak yapışmıştır,

 

[kelkitli]

Sayın Özer elinize sağlık güzel olmuş. Ancak dosyadaki veri sayısı arttık.a hız dişer. Makro ile yapabilirsek daha güzel olur.

 

[İhsan Tank]

Selamlar,
Ekteki dosyada veri sayfası F12:F aralığında işlemler yazılı.
Liste isimli sayfada C sütunundaki yazılı ileme ait veri sayfasında kaç tane kayıt varsa liste F1 deki aya göre gelir ve gider toplamlarını D ve E sütunlarına yazabilirmiyiz.
Saygılar.

Merhaba
Liste sayfasının kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub CommandButton1_Click()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
Set bordo = Sheets("veri")
Set mavi = Sheets("liste")
trabzonspor = MsgBox(mavi.Range("F1") & ". Ay Verilerini " _
& "Topluyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
mavi.Range("D3:E" & Rows.Count).ClearContents
For asi = 3 To mavi.Cells(Rows.Count, "B").End(xlUp).Row
kaplan = 0
trabzonspor = 0
For ts = 12 To bordo.Cells(Rows.Count, "C").End(xlUp).Row
If Month(bordo.Cells(ts, "C")) = mavi.Range("F1") And _
bordo.Cells(ts, "F") = mavi.Cells(asi, "C") Then
kaplan = kaplan + bordo.Cells(ts, "N")
trabzonspor = trabzonspor + bordo.Cells(ts, "O")
mavi.Cells(asi, "D") = kaplan
mavi.Cells(asi, "E") = trabzonspor
End If
Next
Next
Application.ScreenUpdating = True
MsgBox mavi.Range("F1") & ". Ay Verilerini Topladım", , "Bitiş"
End Sub

 

[kelkitli]

Teşekkür ederim İhsan Hocam, hakkınızı ödeyemeyiz, helal edin.

 

[kelkitli]

Hocam sonuçlarda hata var. Tümünün toplamını alıyor. Birde şöyle bir sıkıntı olurmu? Mesela 2012 1. ay ve 2011 1.ay karışırmı?

 

[İhsan Tank]

Hocam sonuçlarda hata var.

Doğrudur aceleye geldi
Kodu güncelledim.

 

[kelkitli]

Hocam tamamdır. Tekrar teşekkür ederim.

 

[İhsan Tank]

Hocam tamamdır. Tekrar teşekkür ederim.

Rica ederim
Sorunuz araya karıştı evet karışır
:keyif:

 

[kelkitli]

O zaman G1 e de yılı mı yazsak Hocam.

 

[İhsan Tank]

O zaman G1 e de yılı mı yazsak Hocam.

O sizin fikriniz ben bilemem bana ay'a göre yapsın dediniz bende yaptırdım. Soru sizin dosya sizin bana derseniz İhsan bunu da ekleyelim ben de eklerim açıkcası

 

[kelkitli]

Hocam o zaman size zahmet ekliyelim.

 

[kelkitli]

İhsan Hocam dünden beri uğraşıyorum yapayım diye ama yapamadım.

 

[İhsan Tank]

İhsan Hocam dünden beri uğraşıyorum yapayım diye ama yapamadım.

Merhaba
Bu kodu dener misiniz_?

Option Explicit
Private Sub CommandButton1_Click()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
Set bordo = Sheets("veri")
Set mavi = Sheets("liste")
If mavi.Range("G1") = Empty Then
MsgBox "Yıl Boş", vbCritical, "Hata"
mavi.Select
Range("G1").Select
Exit Sub
ElseIf mavi.Range("F1") = Empty Then
MsgBox "Ay Boş", vbCritical, "Hata"
mavi.Select
Range("F1").Select
Exit Sub
End If
trabzonspor = MsgBox(mavi.Range("G1") & " Yılının" & vbLf _
& mavi.Range("F1") & ". Ay Verilerini " _
& "Topluyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
mavi.Range("D3:E" & Rows.Count).ClearContents
For asi = 3 To mavi.Cells(Rows.Count, "B").End(xlUp).Row
kaplan = 0
trabzonspor = 0
For ts = 12 To bordo.Cells(Rows.Count, "C").End(xlUp).Row
If Year(bordo.Cells(ts, "C")) = mavi.Range("G1") And _
Month(bordo.Cells(ts, "C")) = mavi.Range("F1") And _
bordo.Cells(ts, "F") = mavi.Cells(asi, "C") Then
kaplan = kaplan + bordo.Cells(ts, "N")
trabzonspor = trabzonspor + bordo.Cells(ts, "O")
mavi.Cells(asi, "D") = kaplan
mavi.Cells(asi, "E") = trabzonspor
End If
Next
Next
Application.ScreenUpdating = True
MsgBox mavi.Range("G1") & " Yılının" & vbLf _
& mavi.Range("F1") & ". Ay Verilerini Topladım", , "Bitiş"
End Sub

 

[kelkitli]

Hocam teşekkür ederim. İşlem tamam.

 

[İhsan Tank]

Hocam teşekkür ederim. İşlem tamam.

Rica ederim
:keyif: