sort ve toplama yardımı

[aykiri]

Merhaba arkadaşlar
ekteki dosyada mavi alandaki verilere benzer bir veri tablom var
yeşil alandakiler gibi olması için gerekli kod konusunda yardımcı olurmusunuz

mavi olan alan orjinalliği bozulmamalı

saygılar

 

[askm]

Aşağıdaki kodları deneyin.

Sub ASKM_Listele()
Dim Son As Long
Son = Range("a" & Rows.Count).End(xlUp).Row
a = 1
Application.ScreenUpdating = False
Range("P1:S65000").ClearContents
For i = 1 To Son
    If WorksheetFunction.CountIfs(Range("A1:A" & i), Cells(i, 1), Range("B1:B" & i), Cells(i, 2)) = 1 Then
        Cells(a, 16) = Cells(i, 1)
        Cells(a, 17) = Cells(i, 2)
        Cells(a, 18) = Cells(i, 3)
        Toplam = WorksheetFunction.SumIfs(Columns(4), Columns(1), Cells(a, 16), Columns(2), Cells(a, 17))
        Cells(a, 19) = Toplam
        a = a + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "A S K M"
End Sub