(31/12/2020, 22:01)berduş yazdı: ADO Kodu:Son kodunuzda Dizi kullandınız
Dictionary kodu Transpose çıkarıldıPrivate Sub BtnADO_Click()
t1 = Now
Sheets("ADO").Cells.Clear
'____________________________________________
Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection
Sql = "SELECT [Sipariş No], First(Kimlik) AS İlkKimlik, First([Firma Adı]) AS [İlkFirma Adı], First([Stok Adı]) AS [İlkStok Adı], " & _
"Sum(Miktar) AS ToplaMiktar, Sum(Tutar) AS ToplaTutar " & _
"FROM deneme " & _
"GROUP BY [Sipariş No] " & _
"ORDER BY [Sipariş No], First(Kimlik), First([Firma Adı]), First([Stok Adı]);"
ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.Path & "\deneme.accdb"
ADO_CN.Open
ADO_RS.Open Sql, ADO_CN, 3, 1
' Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
GoTo son
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst
Sheets("ADO").Range("A1").Resize(1, 6) = Array("Sipariş No", "Kimlik", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
Sheets("ADO").Range("A2").CopyFromRecordset ADO_RS 'excelde
Sheets("ADO").Columns("A:f").AutoFit
son:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
t2 = Now
Debug.Print "ADO", DateDiff("s", t1, t2) & " saniye"
MsgBox DateDiff("s", t1, t2) & " saniye"
End Sub
Private Sub BtnDictDnm_Click()
t1 = Now
Dim say As Long
Dim i As Long, sonLitview As Long
Dim kriter
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
With ThisWorkbook.Sheets("Dict_hy")
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), .ListItems(i).ListSubItems(2), .ListItems(i).ListSubItems(3), .ListItems(i).ListSubItems(4), .ListItems(i).ListSubItems(5))
Else
dic(kriter) = Array(CStr(dic.Item(kriter)(0)), CStr(dic.Item(kriter)(1)), CStr(dic.Item(kriter)(2)), CDbl(dic.Item(kriter)(3)) + .ListItems(i).ListSubItems(4) * 1, CDbl(dic.Item(kriter)(4)) + .ListItems(i).ListSubItems(5) * 1)
End If
Next
End With
.Cells.Clear
Dim KeyDizi, ItemDizi, SonDizi
KeyDizi = dic.Keys
ItemDizi = dic.Items
ReDim SonDizi(LBound(KeyDizi) To UBound(KeyDizi), 0 To 5)
For i = LBound(KeyDizi) To UBound(KeyDizi)
SonDizi(i, 0) = KeyDizi(i)
SonDizi(i, 1) = ItemDizi(i)(0)
SonDizi(i, 2) = ItemDizi(i)(1)
SonDizi(i, 3) = ItemDizi(i)(2)
SonDizi(i, 4) = ItemDizi(i)(3)
SonDizi(i, 5) = ItemDizi(i)(4)
Next i
.Range("A2").Resize(UBound(SonDizi) + 1, 6) = SonDizi
.Range("A1").Resize(1, 6) = Array("Sipariş No", "Kimlik", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
End With
var:
On Error Resume Next
Set dic = Nothing
Erase KeyDizi
Erase ItemDizi
Erase SonDizi
t2 = Now
Debug.Print "Dict_hy", DateDiff("s", t1, t2) & " saniye"
MsgBox DateDiff("s", t1, t2) & " saniye"
End Sub
Benimkindede dizi ile 65536 sonrası geliyordu.
Birde Listview ile fazla uğaraşmıyordum bir hata buldum.
Kod:
.ListItems(i).ListSubItems(1)
Kod:
.ListItems(i).SubItems(1)