çok koşullu toplama

[kucukdunyam]

Buraya; A1:A7 arasındaki sayıların toplamını aldırmak istiyorum,
yani koşula göre C Sütünundaki Veri olan satır ile aynı satırda olan, A sütünündaki verilerin C sütünunda bir sonraki dolu satıra kadar toplamını aldırmak istiyorum. Makro ile de olabilir, formülle de olabilir.

 

[mancubus]

dosyanız açılmadı ama forumda çok koşullu toplam veya sumproduct/topla.çarpım konusunda arama yaparsanız çözüm bulursunuz.

 

[kucukdunyam]

dosya burda

 

[Korhan Ayhan]

Merhaba,

D1 hücresine aşağıdaki formülü uygulayın ve alt hücrelere sürükleyin.

=EĞER(C1="";"";TOPLA(KAYDIR(A1;;;KAÇINCI(MİN(C2:$C$65536);C:C;0)-SATIRSAY(D$1:D1))))

 

[kucukdunyam]

bu işlevi makro ile yapabilirmiyiz? Makroyu çalıştırdığımda o sayfanın bütün satırlarındaki koşullu toplama işlevini yapmasını sağlayabilirmiyiz veri çok olduğundan formül kasıyor

 

[kucukdunyam]

bu işlevi makro ile yapabilirmiyiz? Makroyu çalıştırdığımda o sayfanın bütün satırlarındaki koşullu toplama işlevini yapmasını sağlayabilirmiyiz veri çok olduğundan formül kasıyor

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub TOPLAM_AL()
    Dim İLK_SATIR As Long, SON_SATIR As Long, ADRES As String
    
    Range("H3:H" & Rows.Count).ClearContents
    İLK_SATIR = 3
    
10  SON_SATIR = Cells(İLK_SATIR, "G").End(4).Row - 1
    ADRES = "F" & İLK_SATIR & ":F" & SON_SATIR
    Cells(İLK_SATIR, "H") = WorksheetFunction.Sum(Range(ADRES))
    İLK_SATIR = SON_SATIR + 1
    If İLK_SATIR = Rows.Count Then
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
        Exit Sub
    Else
        GoTo 10
    End If
End Sub

 

[kucukdunyam]

çokkk teşekkür ederim korhan bey,

 

[kucukdunyam]

Makro ile çok koşullu toplama

Merhabalar, eklediğim dosyada bir makro var, o makroyu işlevine göre düzenleyebilirmiyiz, şimdiden çok teşekkür ederim.

 

[kucukdunyam]

Sub ALTTOPLAM_AL()
Dim İLK_SATIR As Long, SON_SATIR As Long, ADRES As String

Range("F3:F" & Rows.Count).ClearContents
İLK_SATIR = 3

10 SON_SATIR = Sheets("GİRİŞ").Cells(İLK_SATIR, "A").End(4).Row - 1
ADRES = "H" & İLK_SATIR & ":H" & SON_SATIR (burayı giriş sayfasındaki H sütününe yöneltmek istesem ne yazabilirim)
Cells(İLK_SATIR, "F") = WorksheetFunction.Sum(Range(ADRES))
İLK_SATIR = SON_SATIR + 1
If İLK_SATIR = Rows.Count Then
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Exit Sub
Else
GoTo 10
End If
End Sub

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Long
    Dim İLK As Long, SON As Long, WF As WorksheetFunction
    Dim Dizi As New Collection, Satır As Long, Son_Satır As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("GİRİŞ")
    Set S2 = Sheets("İSTATİSTİK")
    Set WF = WorksheetFunction
    
    S2.Range("A11:C65536").ClearContents
    İLK = 4
    Satır = 11
    Son_Satır = S1.Cells(Rows.Count, 2).End(3).Row
    
    For X = 4 To Son_Satır
        If X = Son_Satır Then
            SON = X
            Satır = Satır + 1
        End If
        If IsDate(S1.Cells(X, 1)) Then
            S2.Cells(Satır, 1) = S1.Cells(X, 1)
            Satır = Satır + 1
            If X > İLK Then
                SON = X - 1
                On Error Resume Next
                For Y = İLK To SON
                    Dizi.Add CStr(S1.Cells(Y, 2))
                Next
                S2.Cells(Satır - 2, 2) = Dizi.Count
                S2.Cells(Satır - 2, 3) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
                Set Dizi = Nothing
                İLK = SON + 1
            End If
        ElseIf X = SON Then
            On Error Resume Next
            For Y = İLK To SON
                Dizi.Add CStr(S1.Cells(Y, 2))
            Next
            S2.Cells(Satır - 2, 2) = Dizi.Count
            S2.Cells(Satır - 2, 3) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
            Set Dizi = Nothing
            İLK = SON
        End If
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kucukdunyam]

teşekkürler, çokk sağolun.