RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
düzeltilmiş son hali
t1 = Now
Dim dic As Object
Dim say As Long
Dim i As Long, sonLitview As Long
Dim kriter
Set dic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("sayfa1")
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))
Else
dic(kriter) = Array(CStr(dic.Item(kriter)(0)), CStr(dic.Item(kriter)(1)), CDbl(dic.Item(kriter)(2)) + .ListItems(i).ListSubItems(4) * 1, CDbl(dic.Item(kriter)(3)) + .ListItems(i).ListSubItems(5) * 1)
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
' For Each Key In dic
' Debug.Print Key, dic(Key)(0), dic(Key)(1), dic(Key)(2), dic(Key)(3)
' Next
var:
On Error Resume Next
Set dic = Nothing
t2 = Now
'Debug.Print "Dict", DateDiff("s", t1, t2)
MsgBox "Bitti"
sayın @kanakan52 kendi taktirinizdir bir şey diyemem ama denemelerimde 120 bin kayıtta ADO genelde 1-2 saniyede sonucu bulurken dictionary yönteminde süre 4-5 kat daha uzun çıktı
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 30/12/2020
(30/12/2020, 17:05)berduş yazdı: düzeltilmiş son hali
t1 = Now
Dim dic As Object
Dim say As Long
Dim i As Long, sonLitview As Long
Dim kriter
Set dic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("sayfa1")
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))
Else
dic(kriter) = Array(CStr(dic.Item(kriter)(0)), CStr(dic.Item(kriter)(1)), CDbl(dic.Item(kriter)(2)) + .ListItems(i).ListSubItems(4) * 1, CDbl(dic.Item(kriter)(3)) + .ListItems(i).ListSubItems(5) * 1)
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
' For Each Key In dic
' Debug.Print Key, dic(Key)(0), dic(Key)(1), dic(Key)(2), dic(Key)(3)
' Next
var:
On Error Resume Next
Set dic = Nothing
t2 = Now
'Debug.Print "Dict", DateDiff("s", t1, t2)
MsgBox "Bitti"
sayın @kanakan52 kendi taktirinizdir bir şey diyemem ama denemelerimde 120 bin kayıtta ADO genelde 1-2 saniyede sonucu bulurken dictionary yönteminde süre 4-5 kat daha uzun çıktı Böyle Array ile yapınca belki biraz uzun sürebilir lakin normal olarak dictionary ile yapılan bence sürmez abey.
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
(30/12/2020, 20:31)feraz yazdı: Böyle Array ile yapınca belki biraz uzun sürebilir lakin normal olarak dictionary ile yapılan bence sürmez abey. dictionaryle ilgili çok deneyimim yok
ekleyebilirseniz sevinirim
referanslara hem ADO hem de Scripting Runtime eklenmiştir
ADO Kodu:
t1 = Now
Sheets("sayfa2").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("sayfa2").Range("A1").Resize(1, 6) = Array("Kimlik", "Sipariş No", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
Sheets("sayfa2").Range("A2").CopyFromRecordset ADO_RS 'excelde
Sheets("sayfa2").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"
Dictionary Kodu:
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("sayfa1")
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
.Range("A1").Resize(1, 6) = Array("Kimlik", "Sipariş No", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
.Range("B2").Resize(dic.Count, 5) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.Items))
.Range("A2").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
End With
var:
On Error Resume Next
Set dic = Nothing
t2 = Now
Debug.Print "Dict", DateDiff("s", t1, t2) & " saniye"
MsgBox DateDiff("s", t1, t2) & " saniye"
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 30/12/2020
(30/12/2020, 20:56)berduş yazdı: (30/12/2020, 20:31)feraz yazdı: Böyle Array ile yapınca belki biraz uzun sürebilir lakin normal olarak dictionary ile yapılan bence sürmez abey. dictionaryle ilgili çok deneyimim yok
ekleyebilirseniz sevinirim
referanslara hem ADO hem de Scripting Runtime eklenmiştir
ADO Kodu:
t1 = Now
Sheets("sayfa2").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("sayfa2").Range("A1").Resize(1, 6) = Array("Kimlik", "Sipariş No", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
Sheets("sayfa2").Range("A2").CopyFromRecordset ADO_RS 'excelde
Sheets("sayfa2").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"
Dictionary Kodu:
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("sayfa1")
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
.Range("A1").Resize(1, 6) = Array("Kimlik", "Sipariş No", "Firma Adı", "Stok Adı", "Miktar", "Tutar")
.Range("B2").Resize(dic.Count, 5) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.Items))
.Range("A2").Resize(dic.Count, 1) = WorksheetFunction.Transpose(dic.keys)
End With
var:
On Error Resume Next
Set dic = Nothing
t2 = Now
Debug.Print "Dict", DateDiff("s", t1, t2) & " saniye"
MsgBox DateDiff("s", t1, t2) & " saniye"
Denedim abey.Ado 1 saniye,Dictionary ise 6 saniye sürdü yaklaşık 128bin satır için.
Aslında dictionay ile alakalı durum değil döngü Listview için çalıştığı için.
Birde zaten Userforma veri gelmesi 33 saniye sürüyor
Bu arada elinize sağlık kod için.
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
Hesaplamalar zaten userform yuklendikten sonra excele aktarma kodu içindi, form yuklenirken geçen 33 saniyeden sonrası için.
Ama burada ADO, DICTIONARY kıyaslaması yapmıyorum. zaten sorunun listviewden veri almaktan kaynaklandığının farkındayım. Burada tek vurguladığım tek tek listviewden veri almak yerine recordsetle almanın daha hızlı olacağı
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 31/12/2020
(30/12/2020, 23:35)berduş yazdı: Hesaplamalar zaten userform yuklendikten sonra excele aktarma kodu içindi, form yuklenirken geçen 33 saniyeden sonrası için.
Ama burada ADO, DICTIONARY kıyaslaması yapmıyorum. zaten sorunun listviewden veri almaktan kaynaklandığının farkındayım. Burada tek vurguladığım tek tek listviewden veri almak yerine recordsetle almanın daha hızlı olacağı
Order By kullanmadan alttaki gibide aynı sonuç veriyor abey.
Ado normalde daha pratik.
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]"
|