bir sayfadan başka sayfaya koşullu toplama

[akrbas]

Merhaba Arkadaşlar,
konuya çok özür diliyerek başlamak istiyorum, zamanım sorunum olduğu için çok araştırmadan buraya yazıyorum.

ekli dosyada "list" sayfasından "summary" sayfasına , "summary" sayfasında belirtiğim koşullara göre toplam aldırabileceğim bir koda ihtiyacım var. yardımlarnızı rica ediyorum..


şimdiden çok teşekkürler

 

[bedri41]

Summary sayfası C4 hücresi için ;
=TOPLA.ÇARPIM((List!$C$4:$C$27=$B$1)*(List!$B$4:$B$27=$B$2)*(List!$L$4:$L$27))
C5 hücresi için;
=TOPLA.ÇARPIM((List!$C$4:$C$27=$B$1)*(List!$B$4:$B$27=$B$2)*(List!$P$4:$P$27))
Diğerleri içinde son parantez içindeki sütun isimlerini değiştirirsiniz.

Kolay Gelsin

 

[Murat OSMA]

Deneyiniz...
C sütununu sayı olarak biçimlendirin...

[SIZE="2"]Sub Emre()
    Dim i As Integer
    For i = 4 To 50
    With Sheets("List")
    Range("C4").Value = WorksheetFunction.Sum(.Range("L4:L" & i))
    Range("C5").Value = WorksheetFunction.Sum(.Range("P4:P" & i))
    Range("C6").Value = WorksheetFunction.Sum(.Range("I4:I" & i))
    Range("C7").Value = WorksheetFunction.Sum(.Range("E4:E" & i), .Range("F4:F" & i))
    Range("C8").Value = WorksheetFunction.Sum(.Range("M4:M" & i), .Range("N4:N" & i))
    Range("C9").Value = WorksheetFunction.Sum(.Range("K4:K" & i))
    Range("C10").Value = WorksheetFunction.Sum(.Range("O4:O" & i))
    End With: Next i: i = Empty
End Sub[/SIZE]

 

[asi_kral]

Merhaba Arkadaşlar,
konuya çok özür diliyerek başlamak istiyorum, zamanım sorunum olduğu için çok araştırmadan buraya yazıyorum.

ekli dosyada "list" sayfasından "summary" sayfasına , "summary" sayfasında belirtiğim koşullara göre toplam aldırabileceğim bir koda ihtiyacım var. yardımlarnızı rica ediyorum..


şimdiden çok teşekkürler

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub toplam_al_1967()
'Konu       :   Kıstaslara Göre Toplam
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Worksheet
Dim a As Long, b As Long
Application.ScreenUpdating = False
Set asi = Sheets("List"): Set kral = Sheets("Summary")
kral.Range("C4:C10").ClearContents
b = asi.Range("A" & Rows.Count).End(xlUp).Row
asi.Range("A3:P" & b).AutoFilter field:=3, Criteria1:=kral.Range("B1")
asi.Range("A3:P" & b).AutoFilter field:=2, Criteria1:=kral.Range("B2")
If WorksheetFunction.Subtotal(3, asi.Range("A4:A" & b)) > 0 Then
kral.Range("C4") = WorksheetFunction.Subtotal(9, asi.Range("L4:L" & b))
kral.Range("C5") = WorksheetFunction.Subtotal(9, asi.Range("P4:P" & b))
kral.Range("C6") = WorksheetFunction.Subtotal(9, asi.Range("I4:I" & b))
kral.Range("C7") = WorksheetFunction.Subtotal(9, asi.Range("E4:F" & b))
kral.Range("C8") = WorksheetFunction.Subtotal(9, asi.Range("M4:N" & b))
kral.Range("C9") = WorksheetFunction.Subtotal(9, asi.Range("K4:K" & b))
kral.Range("C10") = WorksheetFunction.Subtotal(9, asi.Range("O4:O" & b))
End If
asi.Range("A3:P" & b).AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[akrbas]

çok teşekkürler arkadaşlar........emeklerinize sağlık.....

 

[asi_kral]

çok teşekkürler arkadaşlar........emeklerinize sağlık.....

Kolay Gelsin.