(29/12/2020, 16:10)feraz yazdı: Soru listviewdeki veriler için değilmiydi.Ado ile yapılan Veritabanından veriye göre yapıyor.Normalde dictionary ile yaptığım olmalıydı.
Kod:
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("RAPOR")
.Range("A2:S" & Rows.Count).ClearContents
With Me.ListView1
sonLitview = .ListItems.Count
If sonLitview = 0 Then GoTo var
ReDim arr(1 To sonLitview, 1 To 24)
For i = 1 To sonLitview
kriter = .ListItems(i)
If Not dic.Exists(kriter) Then
son = Sayfa1.Range("A65536").End(xlUp).Row + 1
say = say + 1
dic.Add kriter, say
arr(say, 1) = .ListItems(i)
arr(say, 2) = .ListItems(i).ListSubItems(2)
arr(say, 3) = .ListItems(i).ListSubItems(4)
arr(say, 4) = .ListItems(i).ListSubItems(14)
arr(say, 8) = .ListItems(i).ListSubItems(23)
arr(say, 9) = .ListItems(i).ListSubItems(13)
arr(say, 10) = .ListItems(i).ListSubItems(15)
arr(say, 11) = .ListItems(i).ListSubItems(16)
arr(say, 12) = .ListItems(i).ListSubItems(17)
arr(say, 13) = Replace(.ListItems(i).ListSubItems(18), " ", "")
arr(say, 14) = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(.ListItems(i).ListSubItems(22), "A", ""), "B", ""), "C", ""), "Ç", ""), "D", ""), "E", ""), "F", ""), "G", ""), "H", ""), "I", ""), "İ", ""), "J", ""), "K", ""), "L", ""), "M", ""), "N", ""), "O", ""), "Ö", ""), "P", ""), "R", ""), "S", ""), "Ş", ""), "T", ""), "U", ""), "Ü", ""), "V", ""), "W", ""), "Y", ""), "Z", ""), "Q", ""), ":", "")
End If
arr(dic(kriter), 5) = arr(dic(kriter), 5) + .ListItems(i).ListSubItems(11) + 0
Next
End With
If say > 0 Then .Range("A2").Resize(say, UBound(arr, 2)).Value = arr
End With
var:
On Error Resume Next
MsgBox "bitti"
Set dic = Nothing
Erase arrson=sayfa1.range("a65536").end (xlup).row+1 değişkeni tanımladım
arr(son,say, 2) = .ListItems(i).ListSubItems(2) olarak denedim hata verdi.
onu nasıl aşarım.
