• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listboxda toplamlar yrdm.

Katılım
27 Haziran 2007
Mesajlar
202
Excel Vers. ve Dili
2007
Türkçe
Merhaba arkadaşlar, arkadaşlar eklediğim dosyadaki konu hakkında yardımlarınızı umuyorum.......tşkr..
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,239
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ekte.:cool:
Kod:
Private Sub UserForm_Initialize()
Dim z As Object, a As Long, i As Long, k As Long
ListBox1.ColumnCount = 5
ListBox1.RowSource = "Sayfa1!A2:e" & Cells(65536, "A").End(xlUp).Row
ListBox1.ColumnHeads = True
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 3, 1 To 1)
For i = 0 To ListBox1.ListCount - 1
    If Not z.exists(ListBox1.Column(1, i)) Then
        z.Add ListBox1.Column(1, i), ListBox1.Column(3, i)
        a = a + 1
        ReDim Preserve myarr(1 To 3, 1 To a)
        myarr(1, a) = ListBox1.Column(1, i)
        myarr(2, a) = CDbl(ListBox1.Column(2, i))
        myarr(3, a) = CDbl(ListBox1.Column(4, i))
        Else
        z.Item(ListBox1.Column(1, i)) = z.Item(ListBox1.Column(1, i)) + ListBox1.Column(2, i)
        For k = 1 To UBound(myarr, 2)
            If myarr(1, k) = ListBox1.Column(1, i) Then
                myarr(2, k) = CDbl(myarr(2, k)) + CDbl(ListBox1.Column(2, i))
                myarr(3, k) = CDbl(myarr(3, k)) + CDbl(ListBox1.Column(4, i))
            End If
        Next k
    End If
Next
If a > 0 Then ListBox2.Column = myarr
End Sub
 

Ekli dosyalar

Katılım
27 Haziran 2007
Mesajlar
202
Excel Vers. ve Dili
2007
Türkçe
Evren hocam herseferinde hızırgibi yetişiyorsunuz valla .HELAL SİZE EMEĞİNİZE YÜREĞİNİZE sağlık teşekürler...:dua2::dua2::dua2::dua2::dua2:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,239
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Evren hocam herseferinde hızırgibi yetişiyorsunuz valla .HELAL SİZE EMEĞİNİZE YÜREĞİNİZE sağlık teşekürler...:dua2::dua2::dua2::dua2::dua2:
Rica ederim.
İyi çalışmalar.:cool:
 
Üst