Skip to main content

AccessTr.neT


Tarihe Göre Toplam Almak

Tarihe Göre Toplam Almak

Çözüldü #1
Merhaba Arkadaşlar

Eklediğim uygulamada M6 hücresine tarih yazıp aktar butonuna bastığım zaman o tarihteki işlem yapan gelir ve gideri Sayfa2 ye aktarsın. Kişi bazında toplam olarak Sayfa2 de alt, alta göstersin.

Örneğin: 02.01.2021 yazıp aktar komutunu verdiğim zaman o tarihte Ayşen'in yaptığı işlemlerin toplamını birinci satıra, Keremin yaptığı işlemin toplamını bir alt satıra ve Mehmet'in yaptığı işlemin toplamlarını üçüncü satırda göstersin ve  en alt bir satır boş bırakarak genel toplamları göstersin.

Bu konuda yardımlarınıza ihtiyacım var. Yardımlarınız için şimdiden teşekkürler.
.rar Gelir Gider.rar (Dosya Boyutu: 11,33 KB | İndirme Sayısı: 2)
Cevapla
#2
Arkadaşlar Sorunumu Çoketopla ile çözdüm.

İşlem Yapan boş bırakıldığı zaman aktarma yapmıyor.
Benim istediğim eğer İşlem Yapan hücresi boş ise M6 hücresindeki tarihe göre Gelir ve Giderdeki işlem tutarlarını Sayfa2 deki satır 2 ye aktarsın.
Bunun için aşağıdaki kodu nasıl değiştirebilirim.

Kod:
=ÇOKETOPLA(Sayfa1!D:D;Sayfa1!A:A;Sayfa2!A2;Sayfa1!B:B;"="&Sayfa1!M$6)
.rar Gelir Gider-1.rar (Dosya Boyutu: 10,2 KB | İndirme Sayısı: 2)
Son Düzenleme: 21/05/2021, 22:39, Düzenleyen: m_demir.
Cevapla
#3
Kod:
=ÇOKETOPLA(Sayfa1!D:D;Sayfa1!A:A;A2;Sayfa1!B:B;Sayfa1!M$6)
Merhaba.
Formül olarak yukardaki gibi kısatılıabilinir M6 kısmını.
Kod ile yapınca eklerim.
Cevapla
#4
Sub CokeToplaa()
    Dim son As Long, i As Long
    Dim syf As Worksheet
    Set syf = ThisWorkbook.Sheets("Sayfa2")
    Const satir_bas As Byte = 2
   
    With ThisWorkbook.Sheets("Sayfa1")
        son = syf.Range("A:A").Find("GENEL TOPLAM", , , 1).Row - 1
        syf.Range("B" & satir_bas & "Lol" & son + 1).Value = ""

       
        If son < satir_bas Then Exit Sub
        If son = satir_bas Then son = satir_bas
        For i = satir_bas To son
            syf.Cells(i, 2).Value = WorksheetFunction.SumIfs(.Range("DLol"), _
                                                            .Range("A:A"), syf.Cells(i, 1).Value, _
                                                            .Range("B:B"), .Cells(6, "M").Value)
            syf.Cells(i, 3).Value = WorksheetFunction.SumIfs(.Range("i:i"), _
                                                            .Range("F:F"), syf.Cells(i, 1).Value, _
                                                            .Range("G:G"), .Cells(6, "M").Value)
            syf.Cells(i, 4).Value = syf.Cells(i, 2).Value - syf.Cells(i, 3).Value
                                                           
       
        Next
        son = syf.Range("A:A").Find("GENEL TOPLAM", , , 1).Row
        syf.Range("B" & son).Value = WorksheetFunction.Sum(syf.Range("B" & satir_bas & ":B" & son - 1))
        syf.Range("C" & son).Value = WorksheetFunction.Sum(syf.Range("C" & satir_bas & ":C" & son - 1))
        syf.Cells(son, 4).Value = syf.Cells(son, 2).Value - syf.Cells(son, 3).Value
    End With
    Set syf = Nothing
    MsgBox "Biiti"
End Sub
Cevapla
#5
Alttaki kodda gifteki gibi çalışır.

[Resim: do.php?img=11051]
https://resim.accesstr.net/do.php?img=11051


Sub CokeToplaa()
    Dim son As Long, i As Long
    Dim syf As Worksheet
    Set syf = ThisWorkbook.Sheets("Sayfa2")
    Dim bulGenel As Range
   
   
    Const satir_bas As Byte = 2
   
    With ThisWorkbook.Sheets("Sayfa1")
        syf.Range("B" & satir_bas & "Lol" & Rows.Count).ClearContents
       
        Set bulGenel = syf.Range("A:A").Find("GENEL TOPLAM", , , 1)
        If Not bulGenel Is Nothing Then Rows(bulGenel.Row).Delete
        son = syf.Range("A:A").Find("*", , , , , xlPrevious).Row
     
        If son < satir_bas Then Exit Sub
        If son = satir_bas Then son = satir_bas
        For i = satir_bas To son
            syf.Cells(i, 2).Value = WorksheetFunction.SumIfs(.Range("DLol"), _
                                                             .Range("A:A"), syf.Cells(i, 1).Value, _
                                                             .Range("B:B"), .Cells(6, "M").Value)
            syf.Cells(i, 3).Value = WorksheetFunction.SumIfs(.Range("i:i"), _
                                                             .Range("F:F"), syf.Cells(i, 1).Value, _
                                                             .Range("G:G"), .Cells(6, "M").Value)
            syf.Cells(i, 4).Value = syf.Cells(i, 2).Value - syf.Cells(i, 3).Value
                                                            
       
        Next
        son = syf.Range("A:A").Find("*", , , , , xlPrevious).Row + 2
        syf.Range("A" & son).Value = "GENEL TOPLAM"
       
        syf.Range("B" & son).Value = WorksheetFunction.Sum(syf.Range("B" & satir_bas & ":B" & son - 1))
        syf.Range("C" & son).Value = WorksheetFunction.Sum(syf.Range("C" & satir_bas & ":C" & son - 1))
        syf.Cells(son, 4).Value = syf.Cells(son, 2).Value - syf.Cells(son, 3).Value
    End With
    On Error Resume Next
    Set syf = Nothing: Set bulGenel = Nothing
    On Error GoTo 0
    MsgBox "Biiti"
End Sub
Cevapla
#6
Hocam kodu ekledim hata veriyor.

Kodu eklediğim dosyama uygularmısınız.

Hocam Excel sayfa ve çalışma kitap koruması var.
.rar Gel-Gid.rar (Dosya Boyutu: 80,55 KB | İndirme Sayısı: 3)
Son Düzenleme: 22/05/2021, 13:13, Düzenleyen: m_demir.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da