Scripting dictionary kullanarak verileri Listview'e aktara bilirmiyiz

[programer]

Sayın Orion1'in örneklerinden faydalanarak aşağıdaki kodu kendime göre uyarladım. Kod gayet güzel çalışıyor. Verileri sayfaya değilde listview'e aktara bilirmiyiz.

Private Sub CommandButton1_Click()
Dim list(), i, z, iade

Set s1 = Sheets("Hareket")
Set s2 = Sheets("Scripting_Dictionary")

Application.ScreenUpdating = False
Set z = CreateObject("Scripting.dictionary")
    list = s1.Range("B2:H" & s1.Cells(Rows.Count, "B").End(xlUp).Row).Value
    For i = 1 To UBound(list)
            If list(i, 1) = "Satış_Çıkış" Then
                iade = -1
                Else
                iade = 1
            End If
            If list(i, 1) = "Satış_Çıkış" Then
               If Not z.exists(list(i, 6)) Then
                   z.Add list(i, 6), list(i, 7) * iade
                   Else
                   z.Item(list(i, 6)) = z.Item(list(i, 6)) + (list(i, 7) * iade)
               End If
            ElseIf list(i, 1) = "Giriş_Alış" Then
               If Not z.exists(list(i, 6)) Then
                   z.Add list(i, 6), list(i, 7) * iade
                   Else
                   z.Item(list(i, 6)) = z.Item(list(i, 6)) + (list(i, 7) * iade)
               End If
            End If
    Next i
    If z.Count > 0 Then
       sat = s2.[a65536].End(3).Row + 1
       s2.Range(s2.Cells(2, "a"), s2.Cells(sat, "d")).ClearContents
       
       s2.[a2].Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
       Application.ScreenUpdating = True
    End If
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[programer]

Sayın Orion1'in örneklerinden yararlanarak aşağıdaki kodu kendime göre uyarladım. Umarım diğer arkadaşlara faydalı olur. Ekte örnek dosyada hem sayfaya yazıp ordan listview'e alarak hemde direk listview'e alarak örnekler var. Özellikle envanter raporlarım için bo kudu kullanıcam kod gayet hızlı çalışıyor.

Private Sub CommandButton1_Click()
Dim veri As Worksheet, son2 As Long, z As Object, n As Long
Dim liste(), myarr(), i, j As Long, deg As String
ListView1.View = lvwReport
ListView1.FullRowSelect = True
Set veri = Sheets("Hareket")
son2 = veri.Cells(65536, "A").End(xlUp).Row
If son2 < 2 Then Exit Sub
liste = veri.Range("B2:H" & son2).Value
ReDim myarr(1 To 7, 1 To 65536)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(liste, 1)
    'deg = liste(i, 1) & "-" & liste(i, 6)
    
    If liste(i, 1) = "Satış_Çıkış" Then
       iade = -1
    Else
       iade = 1
    End If
    
    If liste(i, 1) = "Satış_Çıkış" Then
       If Not z.exists(liste(i, 6)) Then
           n = n + 1
           z.Add liste(i, 6), n
           myarr(1, n) = liste(i, 6)
           myarr(2, n) = liste(i, 7) * iade
       Else
       myarr(2, z.Item(liste(i, 6))) = myarr(2, z.Item(liste(i, 6))) + (liste(i, 7) * iade)
       End If
    ElseIf liste(i, 1) = "Giriş_Alış" Then
       If Not z.exists(liste(i, 6)) Then
           n = n + 1
           z.Add liste(i, 6), n
           myarr(1, n) = liste(i, 6)
           myarr(2, n) = liste(i, 7) * iade
       Else
       myarr(2, z.Item(liste(i, 6))) = myarr(2, z.Item(liste(i, 6))) + (liste(i, 7) * iade)
       End If
    End If

Next i
For i = 1 To n
    s = s + 1
    ListView1.ListItems.Add , , s
    ListView1.ListItems(i).SubItems(1) = myarr(1, i)
    ListView1.ListItems(i).SubItems(2) = myarr(2, i)
Next i
End Sub