• DİKKAT

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

En Son Satıra Toplama

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
777
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Merhaba arkadaşlar.

Örnek resimde belirttiğim gibi son dolu satırın iki satır altına verileri toplatmak istiyorum. Daha önceki örneklerden denedim ama yapamadım. Sadece bir satırını toplatabiliyorum. Resimde ne yapmak istediğimi anlattım. Dosyam büyük olduğu için sadece işlemi yapmak istediğim sayfanın resmini gönderdim. Yardımcı olabilirseniz çok sevinirim.
 

Ekli dosyalar

  • örnek topatma.jpg
    örnek topatma.jpg
    576.1 KB · Görüntüleme: 26
Renkler elle verilmişse aşağıdaki linkteki konular işinize yarayabilir.


Bunlarda koşullu biçimlendirme ile renklenmiş hücreler için kaynak linkler.. (Arama yaparsanız daha fazlasına da ulaşabilirsiniz.)
 
Merhaba

Bunu deneyiniz.


Sub BordroTopla() Dim vt As Double ssat = Range("J1048576").End(3).Row For k = 1 To 4 For i = 3 To 10 For j = k + 1 To ssat Step 5 vt = vt + Cells(j, i) Next Cells(ssat + 1 + k, i) = vt vt = 0 Next Next End Sub
 
Merhaba

Bunu deneyiniz.


Sub BordroTopla() Dim vt As Double ssat = Range("J1048576").End(3).Row For k = 1 To 4 For i = 3 To 10 For j = k + 1 To ssat Step 5 vt = vt + Cells(j, i) Next Cells(ssat + 1 + k, i) = vt vt = 0 Next Next End Sub

Teşekkürler arkadaşlar ilginize.

Kırmızı renkli satırda "type mismatch" hatası veriyor. Yalnız kodları ben bir Comandbutton un içine yapıştırdım.

Dim vt As Double
ssat = Range("J1048576").End(3).Row
For k = 1 To 4
For i = 3 To 10
For j = k + 1 To ssat Step 5
vt = vt + Cells(j, i)
Next
Cells(ssat + 1 + k, i) = vt
vt = 0
Next
Next
 
Moderatör tarafında düzenlendi:
Renkler elle verilmişse aşağıdaki linkteki konular işinize yarayabilir.


Bunlarda koşullu biçimlendirme ile renklenmiş hücreler için kaynak linkler.. (Arama yaparsanız daha fazlasına da ulaşabilirsiniz.)

Korhan bey satırlarda renk yok sadece aynı renkteki satırların toplanacağını belirtmek için renklendirdim.
 
Uzman bey yine aynı satırda aynı hatayı verdi. Bir de ara toplam olmayacak. Örnek resimde anlatmaya çalıştım. Formül ile örnek olarak topladım. Zahmet olacak ama bi bakabilir misiniz. Çalıştığım sayfayı göndereceğim ama sayfayı dosyadan ayıramıyorum. Sayfayı yeni kitap olarak kopyalamak istediğimde dosyam kapanıyor ve sayfayı ayıramıyorum.
 

Ekli dosyalar

  • örnekson.jpg
    örnekson.jpg
    649.9 KB · Görüntüleme: 7
Renk olmadığını belirtmediğiniz için bunu bilmem mümkün değil.

C44;
C++:
=TOPLA.ÇARPIM((MOD(SATIR(C$13:C$42)-13;5)+1=SATIR($A1))*(C$13:C$42))
 
Uzman bey yine aynı satırda aynı hatayı verdi. Bir de ara toplam olmayacak. Örnek resimde anlatmaya çalıştım. Formül ile örnek olarak topladım. Zahmet olacak ama bi bakabilir misiniz. Çalıştığım sayfayı göndereceğim ama sayfayı dosyadan ayıramıyorum. Sayfayı yeni kitap olarak kopyalamak istediğimde dosyam kapanıyor ve sayfayı ayıramıyorum.

Merhaba
Kod hata verdiyse bu satırı silin.
Dim vt As Double

Ara toplam olmayacaksa o satırları silin, makro ara toplam almıyor ki?
 
Renk olmadığını belirtmediğiniz için bunu bilmem mümkün değil.

C44;
C++:
=TOPLA.ÇARPIM((MOD(SATIR(C$13:C$42)-12;5)=SATIR($A1))*(C$13:C$42))
Korhan bey resmini gönderdiğim sayfadaki veriler kod ile oluyor. Onun için bu toplama işlemi de kod ile olması gerekiyor.
 
Formülü kullanmak isteye olabilir diye küçük bir revize yaptım.

Makro olarak aşağıdaki kodu kendi dosyanıza uyarlarsınız.

Paylaştığınız görsele göre kurgulanmıştır.

C++:
Option Explicit

Sub Genel_Toplam()
    Dim Son As Long
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    If Son > 13 Then
        With Range("C" & Son + 2).Resize(5, 8)
            .Formula = "=SUMPRODUCT((MOD(ROW(C$13:C$" & Son & ")-13,5)+1=ROW($A1))*(C$13:C$" & Son & "))"
            .Value = .Value
            .Offset(, -1).Cells(1, 1) = "GENEL TOPLAM"
            .Offset(, -1).Cells(1, 1).Resize(5).Merge
            .Offset(, -1).Cells(1, 1).Resize(5, 9).Font.Bold = True
        End With
        MsgBox "Genel toplamlar alınmıştır.", vbInformation
    End If
End Sub
 
Merhaba
Kod hata verdiyse bu satırı silin.
Dim vt As Double

Ara toplam olmayacaksa o satırları silin, makro ara toplam almıyor ki?

Merhaba Uzman bey. Dediğiniz satırı sildim ama yine aynı satırda aynı hatayı verdi. Dosyamı göndersem bakabilir misiniz.
 
Formülü kullanmak isteye olabilir diye küçük bir revize yaptım.

Makro olarak aşağıdaki kodu kendi dosyanıza uyarlarsınız.

Paylaştığınız görsele göre kurgulanmıştır.

C++:
Option Explicit

Sub Genel_Toplam()
    Dim Son As Long
   
    Son = Cells(Rows.Count, 1).End(3).Row
   
    If Son > 13 Then
        With Range("C" & Son + 2).Resize(5, 8)
            .Formula = "=SUMPRODUCT((MOD(ROW(C$13:C$" & Son & ")-13,5)+1=ROW($A1))*(C$13:C$" & Son & "))"
            .Value = .Value
            .Offset(, -1).Cells(1, 1) = "GENEL TOPLAM"
            .Offset(, -1).Cells(1, 1).Resize(5).Merge
            .Offset(, -1).Cells(1, 1).Resize(5, 9).Font.Bold = True
        End With
        MsgBox "Genel toplamlar alınmıştır.", vbInformation
    End If
End Sub
Teşekkürler Korhan bey çözüldü.
 
Arkadaşlar yardımlarınız için çok teşekkür ederim.
 
Geri
Üst