Koşullu toplama

[mesyen47]

Merhaba

A sütununda ki değer değişene kadar b sütununda ki değerleri toplayıp alta yeni bir satır olarak eklemek istiyorum.
Fakat iterasyonu kurgulayamadım. Bir önce ki değerler de toplama işlemine tabi tutuyor. j değerini nasıl tanımlamalıyım?
dosya excel

Sub InsertSumRows()


Dim LastRow As Long
Dim i As Long
Dim j As Long
i = 2
j = 2
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    If Cells(i, "A") <> Cells(i + 1, "A") Then ' if not equal insert row and sum
        Cells(i + 1, "A").EntireRow.Insert
        j = i - j
        Cells(i + 1, "B").Value = Application.Sum(Range(Cells(j, "B"), Cells(i, "B")))
        i = i + 1
    End If
Stop
Next i
End Sub

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Deneme()

Dim i As Long, _
    j As Long
    
j = 2
i = 2

Do
    If Not Cells(i, "A") = Cells(i + 1, "A") Then
        Range("A" & i + 1).EntireRow.Insert
        With Cells(i + 1, "B")
            .Value = Application.Sum(Range(Cells(j, "B"), Cells(i, "B")))
            .Font.Bold = True
        End With
        i = i + 2
        j = i
    Else
        i = i + 1
    End If

Loop Until Cells(i, "A") = ""

End Sub

 

[mesyen47]

Teşekkür ederim. Sorunumu çözdü.