Soru İki Sayı Arası Koşullu Toplama

[TUNCA ERSİN]

Merhaba,

Denersiniz...

Sub Litre_Km()
Dim oDict As Object
Dim s1 As Worksheet
Dim myData As Variant
Dim say, i As Integer
Dim totalLt As Double, totalKm As Double
Dim k


Application.ScreenUpdating = False

Set s1 = Sheets("Sayfa2")
Set oDict = VBA.CreateObject("Scripting.Dictionary")
  
myData = s1.Range("A2:P" & s1.Cells(s1.Rows.Count, "C").End(3).Row).Value

For i = LBound(myData, 1) To UBound(myData, 1)
    If Not oDict.Exists(myData(i, 3)) Then
        oDict.Add myData(i, 3), say
    End If
Next

ReDim myList(1 To UBound(myData, 1) + 1, 1 To 2)

For Each k In oDict.keys
    For i = LBound(myData, 1) + 1 To UBound(myData, 1) + 1
        If s1.Cells(i, "C").Value = k Then
            tmpKm = s1.Cells(i, "P").Value
            If s1.Cells(i, "I").Value = 0 Then
                totalLt = totalLt + s1.Cells(i, "E").Value
            Else
                totalLt = totalLt + s1.Cells(i, "E").Value
                If tmpKm > 0 Then totalKm = s1.Cells(i, "I").Value - tmpKm
                myList(i - 1, 1) = totalKm
                myList(i - 1, 2) = totalLt
                totalLt = 0:    totalKm = 0:   tmpKm = 0
            End If
        End If
    Next i
Next k

s1.Range("Q2").Resize(UBound(myData, 1), 2) = myList

Set s1 = Nothing:  Set oDict = Nothing

MsgBox "İşlem tamam...", vbInformation

Application.ScreenUpdating = True

End Sub

Sy. @dost ;
Hocam
Google E tablolarda nasıl kullanacağım bunu bu kod orada çalışmıyor.

Q sütununa gelen km. şartına sadece Mazot olanlarının şartını getire bilir miyiz.

 

[ÖmerBey]

Merhaba,
Son bir öneride bulunayım.

=EĞER(VE(I2>0;O2="Mazot");-ÇOKETOPLA(E$2:E2;O$2:O2;"Mazot";C$2:C2;C2)-ETOPLA(C$1:C1;C2;R$1:R1);"")

 

[TUNCA ERSİN]

Sy. @ÖmerBey ;
Şimdi tam istediğim gibi oldu teşekkür ederim. Elinize ve Emeğinize sağlık.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...

 

[TUNCA ERSİN]

Sy. @ÖmerBey ;
Hocam Size de iyi çalışmalar