Son dolu sütundan sonra toplama yapma

[sahika51]

Merhaba arkadaşlar örnek çalışmamda son dolu sütundan sonraki sütuna toplama yapmak istiyorum. aylar değiştiğinde toplama songünden sonraki sütuna toplama yapılabilirmi. ve bunu bir makroya atamak istiyorum. Örnek ay 28 gün ise AF sütununa 29 gün ise AG sütununa 30 Gün ise AH sütununa 31 gün ise AI sütununa toplama yapsın.

 

[hasankardas]

Merhaba kodu oluşturduğunuz modüle yapıştırın ve butona atarsınız.
Not: c4 de yazdığınız tarihe göre 5.ci satıra ayın günlerini yazıyor. bunu makroya yazdırmamız gerekiyordu ayın 31 gün altı olduğu zamanlarda problem yaşamamak için.. Son dolu hücreye göre toplama işlemi yaparsınız. makroyu sayfa3 e göre oluştrdum uyarlamasını yaparsınız.

Sub Topla()
    Dim ws As Worksheet
    Dim baslangicTarihi As Date
    Dim gunSayisi As Integer
    Dim i As Integer
    Dim sonSutun_5Satir As Long
    Dim toplamaSutunu As Long
    Dim toplamaAdresi As String
      Set ws = ThisWorkbook.Sheets("Sayfa3")
     On Error GoTo Hata
    baslangicTarihi = ws.Range("C4").Value
        If Not IsDate(baslangicTarihi) Then
        MsgBox "C4 hücresinde tarihi kontrol edin. Tarih formatı noktalı olmalı.", vbCritical
        Exit Sub
    End If
        gunSayisi = Day(DateSerial(Year(baslangicTarihi), Month(baslangicTarihi) + 1, 0))
         ws.Range("D4:AI4").ClearContents
        ws.Range("D5:AI5").ClearContents
        For i = 1 To gunSayisi
        ws.Cells(5, i + 3).Value = Day(DateAdd("d", i - 1, baslangicTarihi))
    Next i
    
    sonSutun_5Satir = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
        toplamaSutunu = sonSutun_5Satir + 1
    
    Dim temizlikSonSutun As Long
    temizlikSonSutun = Application.Min(ws.Columns.Count, toplamaSutunu + 10)
    
    ws.Range(ws.Cells(6, toplamaSutunu), ws.Cells(27, temizlikSonSutun)).ClearContents
    Dim baslangicSutunu As Long
    baslangicSutunu = 4
    
    Dim satir As Long
    For satir = 6 To 27
    toplamaAdresi = ws.Cells(satir, baslangicSutunu).Resize(1, sonSutun_5Satir - baslangicSutunu + 1).Address(False, False)
        
        ws.Cells(satir, toplamaSutunu).Formula = "=SUM(" & toplamaAdresi & ")"
    Next satir
    
    Exit Sub

Hata:
    
    MsgBox "Bir hata oluştu: Verileri kontrol ediniz." & Err.Description, vbCritical

End Sub

 

[muhasebeciyiz]

hasankardaşa alternatif olsun

 

[Korhan Ayhan]

Merhaba,

Makro ile istemişsiniz ama formülle çözümü deneyebilirsiniz.

=ETOPLA($D$4:$AH$4;">0";D6:AH6)

Makro ile alternatif...

Option Explicit

Sub Topla()
    Dim Last_Row As Long

    With Sheets("Sayfa3")
        Last_Row = .Cells(.Rows.Count, "C").End(3).Row
        .Range("AI6:AI" & .Rows.Count).ClearContents
        .Range("AI6:AI" & Last_Row).Formula = "=SUMIF($D$4:$AH$4,"">0"",D6:AH6)"
        .Range("AI6:AI" & Last_Row).Value = .Range("AI6:AI" & Last_Row).Value
    End With
End Sub

 

[hasankardas]

Merhaba,

Makro ile istemişsiniz ama formülle çözümü deneyebilirsiniz.

=ETOPLA($D$4:$AH$4;">0";D6:AH6)

Makro ile alternatif...

Option Explicit

Sub Topla()
    Dim Last_Row As Long

    With Sheets("Sayfa3")
        Last_Row = .Cells(.Rows.Count, "C").End(3).Row
        .Range("AI6:AI" & .Rows.Count).ClearContents
        .Range("AI6:AI" & Last_Row).Formula = "=SUMIF($D$4:$AH$4,"">0"",D6:AH6)"
        .Range("AI6:AI" & Last_Row).Value = .Range("AI6:AI" & Last_Row).Value
    End With
End Sub

Üstat formül ile sabit sütuna toplanıyor.değişken sütun istiyor. sanırım bundan dolayı makro istiyor..

 

[Korhan Ayhan]

Üstat formül ile sabit sütuna toplanıyor.değişken sütun istiyor. sanırım bundan dolayı makro istiyor..

C4 hücresine 01.02.2025 yazıp önerdiğim formülü ve kodu deneyiniz.
Sonrasında C4 hücresine 01.03.2025 yazıp tekrar önerilerimi deneyiniz.

Zaten kurgu değişken tarihe göre işlem yapmaktadır.