İki Dolu Satır Arasındaki Verileri Toplama

[Feylosof]

Değerli üstadlarım hepinize iyi hafta sonları diliyorum.

Ekli dosyamda bulunan dosyada G sütunundaki sayıları A sütununda derslerin toplamları olarak almak istiyorum. Bu işlemi de dosyamın yapısı gereği VBA ile yapmak istiyorum. Çünkü satır sayıları değişken olabiliyor.
Şimdiden teşekkür ederim.

 

[sward175]

Merhaba :Feylosof,
Eki inceleyiniz.
Kod52 satır aralığında çalışacaktır, Satır çoğaltmak isterseniz
Koddaki : for i 3 To 52 son satır olarak değiştirebilirsiniz.
Saygılarımla , sward175

 

[Feylosof]

Sayın @sward175 ilginiz için teşekkür ederim. Sanırım eksik bilgi verdiğim için yanlış anlaşıldım. Şöyle ki: G sütunundaki sayıları H sütununda A Sütunundaki ders aralığına göre fonksiyonla yaptığım toplamları verecek şekilde kod olsun istiyorum.

 

[sward175]

Tekrar Merhaba, Feylosof,
İstediğiniz böyle bir cevaptır herhalde ,
Saygılarımla, sward175

 

[Feylosof]

Tekrar Merhaba, Feylosof,
İstediğiniz böyle bir cevaptır herhalde ,
Saygılarımla, sward175

yok hocam böyle bir şey değil. Yine de teşekkür ederim.

 

[sward175]

Sayın : Feylosof,
Tekrar atıyorum istediğinizi sonradan anladım.
Hoşça Kalın.
Saygılarımla.

 

[Mdemir63]

Selam

Sanırım istediğiniz böyle

 

[Feylosof]

H

Sayın : Feylosof,
Tekrar atıyorum istediğinizi sonradan anladım.
Hoşça Kalın.
Saygılarımla.

Hocam ulaşmak istediğim sonuç budur. Çok teşekkür ederim. Ancak satır aralıklarının sayısı değişken olduğu için kodlarda aralıkları sabit tutmak istemiyorum. Zira her defasında koda müdahale edilmesini gerektirecek. birleştirilen hücre aralıklarında toplama yapacak şekilde olmaz mı

 

[Feylosof]

Selam

Sanırım istediğiniz böyle

Hocam 8. mesajda yazdığım sorun burada da geçerli. Teşekkür ederim.

 

[Feylosof]

Kodun istediğim şekilde düzenlenmesi olası değil midir acaba?
Ustalarımdan istirham ediyorum.

 

[ÖmerFaruk]

İlk yapılan işlemlerin doğru olduğunu varsayarak

Sub TumIslemleriGerceklestir()
    Dim i As Integer, k As Integer, sonSatir As Integer, bak As Integer
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row ' Toplamların ekleneceği satır
    For i = 3 To sonSatir - 1
        Cells(i, 7) = Application.WorksheetFunction.Sum(Range("C" & i).Resize(1, 4))
        If Cells(i, 1) <> "" Then
            Cells(i, 8) = Cells(i, 7) + Cells(i, 8)
            bak = i
        Else
            Cells(bak, 8) = Cells(i, 7) + Cells(bak, 8)
        End If
    Next i
    
    For k = 3 To 8
        Cells(sonSatir, k) = Application.WorksheetFunction.Sum(Cells(3, k).Resize(sonSatir - 3, 1))
    Next k
End Sub

 

[Feylosof]

İlk yapılan işlemlerin doğru olduğunu varsayarak

Sub TumIslemleriGerceklestir()
    Dim i As Integer, k As Integer, sonSatir As Integer, bak As Integer
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row ' Toplamların ekleneceği satır
    For i = 3 To sonSatir - 1
        Cells(i, 7) = Application.WorksheetFunction.Sum(Range("C" & i).Resize(1, 4))
        If Cells(i, 1) <> "" Then
            Cells(i, 8) = Cells(i, 7) + Cells(i, 8)
            bak = i
        Else
            Cells(bak, 8) = Cells(i, 7) + Cells(bak, 8)
        End If
    Next i
  
    For k = 3 To 8
        Cells(sonSatir, k) = Application.WorksheetFunction.Sum(Cells(3, k).Resize(sonSatir - 3, 1))
    Next k
End Sub

Üstadım çok teşekkür ederim. Çok iyi oldu. Bir şey daha sorabilir miyim? Toplamları sadece G sütunundan alabilir miyiz. G sütunundaki toplamların hazır olduğunu varsayarak. Ekli dosyada olduğu gibi

 

[Ziynettin]

Alternatif,

Sub test()

With Sheets("TOPLAM")
    son = .Range("A" & Rows.Count).End(3).Row
    a = .Range("A2:G" & son).Value
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then y = a(i, 1)
        a(i, 1) = y
    Next i
    
    ReDim b(1 To UBound(a), 1 To 1)
    
    j = 2
    Do While j <= UBound(a)
        krt = a(j, 1): sat = j - 1
        topla = 0
        Do While a(j, 1) = krt
            topla = topla + a(j, 7)
            j = j + 1: If j > UBound(a) Then Exit Do
        Loop
        b(sat, 1) = topla
    Loop
    
    .[H3].Resize(UBound(a) - 1) = b
    
End With

End Sub

 

[ÖmerFaruk]

Üstadım çok teşekkür ederim. Çok iyi oldu. Bir şey daha sorabilir miyim? Toplamları sadece G sütunundan alabilir miyiz. G sütunundaki toplamların hazır olduğunu varsayarak. Ekli dosyada olduğu gibi

Satırın başına tek tırnak koyun yeterli olacaktır
'Cells(i, 7) = Application.WorksheetFunction.Sum(Range("C" & i).Resize(1, 4))

Eğer en alttaki toplam satırından bahsediyorsanız For k = 3 To 8
kısmında

sadece G için
For k=7 to 7

G ve H istiyorsanız
For k=7 to 8

 

[Feylosof]

Satırın başına tek tırnak koyun yeterli olacaktır
'Cells(i, 7) = Application.WorksheetFunction.Sum(Range("C" & i).Resize(1, 4))

Eğer en alttaki toplam satırından bahsediyorsanız For k = 3 To 8
kısmında

sadece G için
For k=7 to 7

G ve H istiyorsanız
For k=7 to 8

Üstadım çok teşekkür ederim.

 

[Feylosof]

Alternatif,

Sub test()

With Sheets("TOPLAM")
    son = .Range("A" & Rows.Count).End(3).Row
    a = .Range("A2:G" & son).Value
    For i = 1 To UBound(a)
        If a(i, 1) <> "" Then y = a(i, 1)
        a(i, 1) = y
    Next i
   
    ReDim b(1 To UBound(a), 1 To 1)
   
    j = 2
    Do While j <= UBound(a)
        krt = a(j, 1): sat = j - 1
        topla = 0
        Do While a(j, 1) = krt
            topla = topla + a(j, 7)
            j = j + 1: If j > UBound(a) Then Exit Do
        Loop
        b(sat, 1) = topla
    Loop
   
    .[H3].Resize(UBound(a) - 1) = b
   
End With

End Sub

Ziynettin hocam desteğiniz için size de çok teşekkür ederim

 

[Korhan Ayhan]

Alternatif...

Option Explicit

Sub X_SUM()
    Dim Rng As Range
    
    Range("H3:H" & Rows.Count).ClearContents
    
    For Each Rng In Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
        If Rng.MergeArea.Cells(1, 1) <> "" Then
            Cells(Rng.Row, "H") = WorksheetFunction.Sum(Rng.MergeArea.Offset(, 6).Resize(Rng.MergeArea.Rows.Count))
        End If
    Next
End Sub

 

[Feylosof]

Alternatif...

Option Explicit

Sub X_SUM()
    Dim Rng As Range
   
    Range("H3:H" & Rows.Count).ClearContents
   
    For Each Rng In Range("A3:A" & Cells(Rows.Count, 1).End(3).Row)
        If Rng.MergeArea.Cells(1, 1) <> "" Then
            Cells(Rng.Row, "H") = WorksheetFunction.Sum(Rng.MergeArea.Offset(, 6).Resize(Rng.MergeArea.Rows.Count))
        End If
    Next
End Sub

Teşekkürler Korhan Hocam.