Tarih Aralığına ve Koda Uygun Verilerin Toplamını Hesaplama

[baydeniro]

Merhaba Arkadaşlar,

D sütununda bulunan verilerin KAYIT sayfasındaki verilerden toplamlarının E6-F6-G6 hücrelerindeki koşullara göre toplam rakamlarının hesaplanması.
E6 daki koda eşit olan
F6 daki tarihe eşit ve büyük
G6 daki tarihe eşit ve küçük verilerin toplamının alınması. Hesaplama modeli biraz komplike olduğu için detaylar örnek dosyada.

Link : http://s7.dosya.tc/server12/8gqme1/KOSULLU_VERI_DERLEME.xls.html

 

[Ömer BARAN]

Merhaba.

MAKRO-VBA bölümüne konu açmışsınız ancak şimdilik formül ile çözüm önerisinde bulunayım.
RAPOR sayfası D sütunundaki ürün adlarının hazır olduğu varsayılmıştır.
-- E10 hücresine;

=TOPLA.ÇARPIM((KAYIT!$E$11:$E$30=$E$6)*(KAYIT!$D$11:$D$30>=$F$6)*(KAYIT!$D$11:$D$30<=$G$6)*((KAYIT!$C$11:$C$30=$D10)*(KAYIT!$H$11:$H$30)+(KAYIT!$J$11:$J$30=$D10)*(KAYIT!$I$11:$I$30)))

-- F10 hücresine;

=TOPLA.ÇARPIM((KAYIT!$E$11:$E$30=$E$6)*(KAYIT!$D$11:$D$30>=$F$6)*(KAYIT!$D$11:$D$30<=$G$6)*((KAYIT!$C$11:$C$30=$D10)*(KAYIT!$I$11:$I$30)+(KAYIT!$J$11:$J$30=$D10)*(KAYIT!$H$11:$H$30)))

--G10 hücresine;

=($E10>$F10)*($E10-$F10)

-- H10 hücresine;

=($E10<$F10)*($F10-$E10)

 

[Ömer BARAN]

Bir önceki cevabımda formül ile çözüm vermiştim. Bu da makro ile çözüm önerisi.
RAPOR sayfası D sütunundaki ürün adlarının hazır olduğu varsayılmıştır.

Sub OZET_HESAPLA()
Set k = Sheets("KAYIT"): Set r = Sheets("RAPOR")
kson = k.Cells(Rows.Count, 1).End(3).Row: rson = r.[D9].End(xlDown).Row
If k.AutoFilterMode = True Then k.AutoFilterMode = False
r.Range("E10:H" & rson).ClearContents
If r.[E6] = "" Or r.[F6] = "" Or r.[G6] = "" Or r.[F6] > r.[G6] Then
    MsgBox "Kriterler eksik veya hatalı, kriterleri kontrol ediniz!", vbCritical
    Exit Sub
End If
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
k.Range("A10:J" & kson).AutoFilter Field:=4, Criteria1:= ">=" & CLng(CDate(r.[F6])), _
                            Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(r.[G6]))
k.Range("A10:J" & kson).AutoFilter Field:=5, Criteria1:=r.[E6]
r.Range("E10:H" & rson) = 0
For Each hcr In k.Range("C11:C" & kson).SpecialCells(xlCellTypeVisible)
    If WorksheetFunction.CountIf(r.Range("D10:D" & rson), hcr.Value) > 0 Then
        rsat = WorksheetFunction.Match(hcr.Value, r.Range("D10:D" & rson), 0) + 9
        r.Cells(rsat, "E") = r.Cells(rsat, "E") + k.Cells(hcr.Row, "H")
        r.Cells(rsat, "F") = r.Cells(rsat, "F") + k.Cells(hcr.Row, "I")
    ElseIf WorksheetFunction.CountIf(r.Range("D10:D" & rson), k.Cells(hcr.Row, "J")) > 0 Then
        rsat = WorksheetFunction.Match(k.Cells(hcr.Row, "J"), r.Range("D10:D" & rson), 0) + 9
        r.Cells(rsat, "E") = r.Cells(rsat, "E") + k.Cells(hcr.Row, "I")
        r.Cells(rsat, "F") = r.Cells(rsat, "F") + k.Cells(hcr.Row, "H")
    End If
Next
For sat = 10 To rson
    If r.Cells(sat, "E") > r.Cells(sat, "F") Then r.Cells(sat, "G") = r.Cells(sat, "E") - r.Cells(sat, "F")
    If r.Cells(sat, "E") < r.Cells(sat, "F") Then r.Cells(sat, "H") = r.Cells(sat, "F") - r.Cells(sat, "E")
Next
k.AutoFilterMode = False
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[baydeniro]

Ömer Baran üstadım resmen şapka çıkarıyorum. Tebrik x Tebrikler. Açıkçası konuyu açarken böyle bir kodun yapılabileceğine dair pek umudum yoktu. Allah aklınıza zeval vermesin, muhteşem bir kod olmuş. Elinize sağlık.

Ddeğerli zamanınız ayırıp bizlere yardımcı olduğunuz için sizin nezdinizde bütün üstadlara çok teşekkür ediyorum. Sağlıcakla kalın.

 

[Ömer BARAN]

Eyvallah, kolay gelsin.