bu da başka bir yöntem @feraz hocamın yardımlarıyla çok teşekkür ederim
tek farkı aradan 2. diziyi çıkarması

    Dim dic As Object

    Dim say As Long

    Dim i As Long, sonLitview As Long

    Dim kriter, arr()

    

    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.Remove (kriter)

                    dic.Add kriter, Array(kr0, kr1, kr2 + .ListItems(i).ListSubItems(4), kr3 + .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

    Set dic = Nothing

    MsgBox "bitti"