Şarta göre otomatik toplam

[ijol]

Merhaba,

otomatik olarak satırdaki belli hücreleri a sutununa toplanması konusunda yardımcı olurmusunuz.

Örneği a1 hücresine, e1+h1+k1+n1... şeklinde her 3 sutunda bir toplam olacak şekilde nasıl ayarlayabiliriz. manuel olarak yapılır ama her eklenen sayı için formüle ekleme yapılmasını istemiyorum.

 

[çıtır]

Sorunuzu örnek dosya ekleyerek sorarsanız daha kısa zamanda ve doğru cevap alabilirsiniz. Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz: https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/...

 

[ijol]

Merhaba,
örnek dosya ve soru link içerisindeki dosyadadır.
https://yadi.sk/i/ypi84hKMA5Iz_g

 

[çıtır]

A6 Hücresine kopyalayınız.Aşağı doğru çoğaltınız.

=TOPLA.ÇARPIM((D6:P6)*(MOD(SÜTUN(D6:P6);3)=1))

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D1:XFD" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Column Mod 3 = 1 Then
    If WorksheetFunction.Sum(Range(Cells(Target.Row, Target.Column + 1), Cells(Target.Row, "XFD"))) = 0 Then
        formul = Replace(Cells(Target.Row, "A").Formula, "$", "")
        If Replace(formul, Replace(Target.Address, "$", ""), "") = formul Then
            Cells(Target.Row, "A").Formula = Cells(Target.Row, "A").Formula & "+" & Target.Address
        End If
    End If
End If
End Sub

 

[çıtır]

Üstad kodunuzu denedim aşağıdaki sonuçu verdi.Uygulama hatası mı yapıyorum?

 

[YUSUF44]

Kod, A sütununda mevcut formüllere işlem yapılan hücrenin adresini ekliyor. Anladığım kadarıyla sizin dosyada A sütununda formül yok. Formül olmayanlar için farklı bir uygulama yapmak gerekir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D1:XFD" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Column Mod 3 = 1 Then
    If WorksheetFunction.Sum(Range(Cells(Target.Row, Target.Column + 1), Cells(Target.Row, "XFD"))) = 0 Then
        If Cells(Target.Row, "A") = "" Then
            Cells(Target.Row, "A").Formula = "=" & Target.Address
        Else
            formul = Replace(Cells(Target.Row, "A").Formula, "$", "")
            If Replace(formul, Replace(Target.Address, "$", ""), "") = formul Then
                Cells(Target.Row, "A").Formula = Cells(Target.Row, "A").Formula & "+" & Target.Address
            End If
        End If
    End If
End If
End Sub