Private Sub CommandButton1_Click()
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("J2:O" & Rows.Count).ClearContents
With Me.ListView1
sonLitview = .ListItems.Count
If sonLitview = 0 Then GoTo var
ReDim arr(1 To sonLitview, 1 To 6)
For i = 1 To sonLitview
kriter = .ListItems(i).ListSubItems(1)
If Not dic.Exists(kriter) Then
say = say + 1
dic.Add kriter, say
arr(say, 1) = .ListItems(i)
arr(say, 2) = .ListItems(i).ListSubItems(1)
arr(say, 3) = .ListItems(i).ListSubItems(2)
arr(say, 4) = .ListItems(i).ListSubItems(3)
End If
arr(dic(kriter), 5) = arr(dic(kriter), 5) + .ListItems(i).ListSubItems(4) + 0
arr(dic(kriter), 6) = arr(dic(kriter), 6) + .ListItems(i).ListSubItems(5) + 0
Next
End With
If say > 0 Then .Range("J2").Resize(say, 6).Value = arr
End With
var:
On Error Resume Next
MsgBox "bitti"
Set dic = Nothing
Erase arr
End Sub
Buda Userformdaki butona tıklayınca listviewdeki verilerden toplar.
