• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Son dolu sütundan sonra toplama yapma

S

sahika51

Altın Üye
Katılım
28 Ekim 2006
Mesajlar
187
Excel Vers. ve Dili
2010-2019
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.
 

Ekli dosyalar

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.


Kod: 
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
 
Merhaba,

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

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


Makro ile alternatif...

C++: 
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
 
Korhan Ayhan' Alıntı:
Merhaba,

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

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


Makro ile alternatif...

C++: 
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
Genişletmek için tıkla ...
Üstat formül ile sabit sütuna toplanıyor.değişken sütun istiyor. sanırım bundan dolayı makro istiyor..
 
hasankardas' Alıntı:
Üstat formül ile sabit sütuna toplanıyor.değişken sütun istiyor. sanırım bundan dolayı makro istiyor..
Genişletmek için tıkla ...

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.
 
muhasebeciyiz' Alıntı:
bakınız
Genişletmek için tıkla ...
üstat ayın 28 den sonrasını doldurmuyor kontrol eder misin sonra kullanmak isteyen olabilir.

Çok teşekkür ederim. istediğim gibi olmuş. Sütunun üstüne Toplam yazabilirmiyiz birde sayı 27 kişiden farklı olabilir. sayı dinamik olsa
Genişletmek için tıkla ...
4 cü satıra tarih verisi getirildi
kaç satır doluysa ona göre dinamik toplama yapıyor.
üst hücreye "Toplam" yazılıyor..
topmaı "0" olan hücreler artık boş görünüyor..

Kod: 
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
    Dim sonSatir As Long
    Dim temizlikSonSutun As Long
    Dim baslangicSutunu As Long
    
    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ı (örn: 01.11.2025).", vbCritical
        Exit Sub
    End If
      
    gunSayisi = Day(DateSerial(Year(baslangicTarihi), Month(baslangicTarihi) + 1, 0))
        
    With ws.Range("D4:AI5")
        .UnMerge
        .ClearContents
    End With
        
    For i = 1 To gunSayisi
                ws.Cells(5, i + 3).Value = Day(DateAdd("d", i - 1, baslangicTarihi))
        ws.Cells(4, i + 3).Value = Format(baslangicTarihi, "mmmm yyyy")
    Next i
    sonSutun_5Satir = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
    toplamaSutunu = sonSutun_5Satir + 1
  
    ws.Cells(5, toplamaSutunu).Value = "Toplam"
    ws.Cells(5, toplamaSutunu).Font.Bold = True
    
    sonSatir = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    If sonSatir < 6 Then sonSatir = 6
    
    temizlikSonSutun = Application.Min(ws.Columns.Count, toplamaSutunu + 10)
    ws.Range(ws.Cells(6, toplamaSutunu), ws.Cells(sonSatir, temizlikSonSutun)).ClearContents
  
    baslangicSutunu = 4
    Dim satir As Long
    
    For satir = 6 To sonSatir
        
        toplamaAdresi = ws.Cells(satir, baslangicSutunu).Resize(1, sonSutun_5Satir - baslangicSutunu + 1).Address(False, False)
        
        ws.Cells(satir, toplamaSutunu).Formula = "=IF(SUM(" & toplamaAdresi & ")=0, """", SUM(" & toplamaAdresi & "))"
    Next satir
  
    Exit Sub

Hata:
    MsgBox "Bir hata oluştu: " & Err.Description, vbCritical
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst