+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Listviewden Excele Aktarımda Sumıf Kullanımı (/konu-listviewden-excele-aktarimda-sumif-kullanimi.html)
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
bu da başka bir yöntem @feraz hocamın yardımlarıyla çok teşekkür ederim
tek farkı aradan 2. diziyi çıkarması
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("A2:O" & Rows.Count).ClearContents
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))
kr0 = dic.Item(kriter)(0)
kr1 = dic.Item(kriter)(1)
Else
kr2 = CDbl(dic.Item(kriter)(2))
kr3 = CDbl(dic.Item(kriter)(3))
dic.Remove (kriter)
dic.Add kriter, Array(kr0, kr1, kr2 + .ListItems(i).ListSubItems(4), kr3 + .ListItems(i).ListSubItems(5))
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
var:
On Error Resume Next
Set dic = Nothing
MsgBox "bitti"RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
yada
Dim dic As Object
Dim i As Long, sonLitview As Long
Dim kriter
Set dic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Sheet1")
.Range("A2:O" & Rows.Count).ClearContents
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))
kr0 = dic.Item(kriter)(0)
kr1 = dic.Item(kriter)(1)
Else
kr2 = CDbl(dic.Item(kriter)(2))
kr3 = CDbl(dic.Item(kriter)(3))
dic(kriter) = Array(kr0, kr1, CDbl(dic.Item(kriter)(2)) + .ListItems(i).ListSubItems(4), CDbl(dic.Item(kriter)(3)) + .ListItems(i).ListSubItems(5))
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
var:
On Error Resume Next
MsgBox "bitti"
Set dic = NothingRE: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 30/12/2020
(30/12/2020, 02:16)berduş yazdı: WorksheetFunction.TransposeAslında bu 65536 satırdan sonrası için sapıtır
Bunsuz kodu ayarlamak gerekebilir büyük veriler için.Heralde verdiğim dosyada veriler böyleydi.Ayarlamaya çalışırım yada sizde yapabilirsiniz.Dediğim gibi transpose olayı 65536 satırdan fazla olunca tam çalışmıyor.
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
O zaman aklima gelmişken
1 - normal diziler en fazla ne kadar aliyor
2 - listviewin limiti ne? ben 32000 küsür satır diye okumuştum bir yerde bu durumda transpose sorun çıkarmamalı.
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - kanakan52 - 30/12/2020
@feraz hocam @berduş hocam
ya ben size nidem he nidem
gece gece neler yapmışsınız. Emeğinize ellerinize sağlık, iyiki varsınız.Kodların hepsini tek tek denemedim ama arşivime kaydediyorum.. Kendi çalışmama uyarlamış olduğum @feraz hocamın koduna aşağıdaki ilaveyei yapmam yetti.
Hepinizden Allah razı olsun, sağlıklı huzurlu yıllar diliyorum.
RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 30/12/2020
rica ederim
İyi çalışmalar
mutlu yıllar