AccessTr.neT
Listviewden Excele Aktarımda Sumıf Kullanımı - Baskı Önizleme

+- 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)

Sayfalar: 1 2 3 4 5 6 7 8 9 10


Listviewden Excele Aktarımda Sumıf Kullanımı - kanakan52 - 28/12/2020

Değerli Hocalarım Merhaba,

Veritabanından Listview'e alınan veriyi etopla ile özet olarak excele aktarabilir miyiz? Biraz kafa yordum çıkamadım içinden?

Yardımlarınız için şimdiden teşekkür ederim.


RE: Listviewden Excele Aktarımda Sumıf Kullanımı - berduş - 28/12/2020

yalnız şöyle bir sorun var: toplama işlemi Sipariş Noya göre yapılabilir ama mesela X0000000000001 nolu sipariş için 3 farlı firma ve stok adı var hangi firma ve stok adı yazılacak


Re: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 29/12/2020

Sonuç J:O aralığına gelir.Gerekärse ADO ilede yapılabilir.

Sub Etopla()

    Dim dic As Object
    Dim say As Long
    Dim i As Long
    Dim kriter, arr()
    Dim sonSatir As Long
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    With ThisWorkbook.Sheets("Sheet1")
        sonSatir = .Cells(Rows.Count, 1).End(3).Row
        .Range("J2:O" & Rows.Count).ClearContents
        If sonSatir < 2 Then GoTo var
        ReDim arr(1 To sonSatir, 1 To 6)
       
        For i = 2 To sonSatir
            kriter = .Cells(i, 2).Value
            If Not dic.Exists(kriter) Then
                say = say + 1
                dic.Add kriter, say
                arr(say, 1) = .Cells(i, 1).Value
                arr(say, 2) = .Cells(i, 2).Value
                arr(say, 3) = .Cells(i, 3).Value
                arr(say, 4) = .Cells(i, 4).Value
            End If
            arr(dic(kriter), 5) = arr(dic(kriter), 5) + .Cells(i, 5).Value
            arr(dic(kriter), 6) = arr(dic(kriter), 6) + .Cells(i, 6).Value
        Next
        If say > 0 Then .Range("J2").Resize(say, 6).Value = arr
    End With
var:
    MsgBox "bitti"
    Set dic = Nothing
    Erase arr
End Sub



Re: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 29/12/2020

Buda veri çoksa hızlı çalışması gerek.

Sub Etopla()
    Dim dic As Object
    Dim say As Long
    Dim i As Long
    Dim kriter, arr(), dizi
    Dim sonSatir As Long
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    With ThisWorkbook.Sheets("Sheet1")
        sonSatir = .Cells(Rows.Count, 1).End(3).Row
        .Range("J2:O" & Rows.Count).ClearContents
        If sonSatir < 2 Then GoTo var
        dizi = .Range("A2:F" & sonSatir).Value
        ReDim arr(1 To sonSatir, 1 To 6)
        For i = 1 To UBound(dizi)
            kriter = CStr(dizi(i, 2))
            If Not dic.Exists(kriter) Then
                say = say + 1
                dic.Add kriter, say
                arr(say, 1) = dizi(i, 1)
                arr(say, 2) = dizi(i, 2)
                arr(say, 3) = dizi(i, 3)
                arr(say, 4) = dizi(i, 4)
            End If
            arr(dic(kriter), 5) = arr(dic(kriter), 5) + dizi(i, 5) + 0
            arr(dic(kriter), 6) = arr(dic(kriter), 6) + dizi(i, 6) + 0
        Next
        If say > 0 Then .Range("J2").Resize(say, UBound(arr, 2)).Value = arr
    End With
var:
    On Error Resume Next
    MsgBox "bitti"
    Set dic = Nothing
    Erase arr: Erase dizi
End Sub



RE: Listviewden Excele Aktarımda Sumıf Kullanımı - feraz - 29/12/2020

Buda Userformdaki butona tıklayınca listviewdeki verilerden toplar.

Private Sub CommandButton1_Click()
    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("J2:O" & Rows.Count).ClearContents
        With Me.ListView1
            sonLitview = .ListItems.Count
            If sonLitview = 0 Then GoTo var
            ReDim arr(1 To sonLitview, 1 To 6)
           
            For i = 1 To sonLitview
                kriter = .ListItems(i).ListSubItems(1)
                If Not dic.Exists(kriter) Then
                    say = say + 1
                    dic.Add kriter, say
                    arr(say, 1) = .ListItems(i)
                    arr(say, 2) = .ListItems(i).ListSubItems(1)
                    arr(say, 3) = .ListItems(i).ListSubItems(2)
                    arr(say, 4) = .ListItems(i).ListSubItems(3)
                End If
                arr(dic(kriter), 5) = arr(dic(kriter), 5) + .ListItems(i).ListSubItems(4) + 0
                arr(dic(kriter), 6) = arr(dic(kriter), 6) + .ListItems(i).ListSubItems(5) + 0
            Next
        End With
        If say > 0 Then .Range("J2").Resize(say, 6).Value = arr
    End With
var:
    On Error Resume Next
    MsgBox "bitti"
    Set dic = Nothing
    Erase arr
End Sub



RE: Listviewden Excele Aktarımda Sumıf Kullanımı - kanakan52 - 29/12/2020

(28/12/2020, 22:22)berduş yazdı: yalnız şöyle bir sorun var: toplama işlemi Sipariş Noya göre yapılabilir ama mesela X0000000000001  nolu sipariş için 3 farlı firma ve stok adı var hangi firma ve stok adı yazılacak


@berduş hocam selamlar,

Sadece sipariş numrasına göre toplam alıcak, firma ve stok adını görmezden gelecek.

@feraz hocam selamlar,

Tüm ilk fırsatta deneyip sonucu bildireceğim. Yine döktürmüşsün emeğine zihnine sağlık.

Selam ve dua ile..