Dim dic As Object

      Dim i As Long, sonLitview As Long

    Dim kriter

    

    Set dic = CreateObject("Scripting.Dictionary")

    

    With ThisWorkbook.Sheets("Sheet1")

        .Range("A2:O" & Rows.Count).ClearContents

        With Me.ListView1

            sonLitview = .ListItems.Count

            If sonLitview = 0 Then GoTo var

            

            For i = 1 To sonLitview

                kriter = .ListItems(i).ListSubItems(1)

                

                If Not dic.Exists(kriter) Then

                  dic.Add kriter, Array(.ListItems(i).ListSubItems(2), .ListItems(i).ListSubItems(3), .ListItems(i).ListSubItems(4), .ListItems(i).ListSubItems(5))

                    kr0 = dic.Item(kriter)(0)

                    kr1 = dic.Item(kriter)(1)

                Else

                    kr2 = CDbl(dic.Item(kriter)(2))

                    kr3 = CDbl(dic.Item(kriter)(3))

                    dic(kriter) = Array(kr0, kr1, CDbl(dic.Item(kriter)(2)) + .ListItems(i).ListSubItems(4), CDbl(dic.Item(kriter)(3)) + .ListItems(i).ListSubItems(5))

                End If





            Next

        End With

            Range("B1").Resize(dic.Count, 4) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.Items))

            Range("A1").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)

    End With



var:

    On Error Resume Next

    MsgBox "bitti"

    Set dic = Nothing