Listboxda 11. kolondaki değerleri toplatmak

[udentr2002]

Merhaba arkadaşlar listboxda 11. kolondaki değerleri toplatıp textboxa yazırabilmem için nasıl bir kod yazabilirim?

 

[Orion1]

Merhaba arkadaşlar listboxda 11. kolondaki değerleri toplatıp textboxa yazırabilmem için nasıl bir kod yazabilirim?

Sizin önceki dosyanız dan bahsediyorsanız.Süzme yapılacağı anda 11nci kolunun tolamını almak dağa hızlı olacaktır.
Süzme yapılan benim yaptığım listele prosedürünü buraya yazarsanız hemen cevap verebirim.Ama isterseniz.İşin uzunu olan kodu yazayım.
Kodlar aşağıda.
Listbox1'de 11nci kolon Tetxbox1'de toplanıyor.

Dim toplam As Double
For i = 0 To ListBox1.ListCount - 1
    toplam = ListBox1.Column(10, i) + toplam
Next
TextBox1.Value = Format(toplam, "#,##0.00")

 

[udentr2002]

hocam sizin gösndermiş olduğunuz listele adlı kodlar aşağıdadır

Sub listele()
Dim i As Long, a As Long, k As Byte, deg As Double
ListBox1.RowSource = ""
ReDim myarr(1 To 12, 1 To 1)
For i = 3 To Cells(65536, "B").End(xlUp).Row
    If LCase(Replace(Replace(Cells(i, "C").Value, "I", "ı"), "İ", "i")) Like ComboBox1.Value & "*" _
    And LCase(Replace(Replace(Cells(i, "E").Value, "I", "ı"), "İ", "i")) Like ComboBox2.Value & "*" _
    And LCase(Replace(Replace(Cells(i, "F").Value, "I", "ı"), "İ", "i")) Like ComboBox3.Value & "*" Then
    
        a = a + 1
        ReDim Preserve myarr(1 To 12, 1 To a)
        For k = 1 To 12
            myarr(k, a) = Cells(i, k).Value
        Next k
        If a = 1 Then
            deg = Cells(i, 10).Value
            ElseIf Cells(i, 10).Value < deg Then
            deg = Cells(i, 10).Value
        End If
    End If
Next i
If a > 0 Then ListBox1.Column = myarr
Erase myarr
Label17.Caption = Format(deg, "#,##0.00") & " " & "YTL'dir"


End Sub

yanlız ben sizin o uzun dediğiniz kodu kullanmaya çalıştım ama olmadı
bakabilirseniz çok teşekkür ederim hocam

 

[udentr2002]

hocam çok teşekkkür ederim ben kodunuzu kullanırken bir yerde hata yaptığımdan dolayı olmuyormuş dediğiniz gibi süzme işleminin yapıldığı yere yazdım kod çalışıyor çok teşşekkür ederim istediğim buydu ellerinize sağlık

 

[Orion1]

Aşağıdaki değişiklikleri yapıp kulanırsanız kodlar dağa hızlı çalışacaktır.

Sub listele()
Dim i As Long, a As Long, k As Byte, deg As Double,toplam as double
ListBox1.RowSource = ""
ReDim myarr(1 To 12, 1 To 1)
For i = 3 To Cells(65536, "B").End(xlUp).Row
    If LCase(Replace(Replace(Cells(i, "C").Value, "I", "ı"), "İ", "i")) Like ComboBox1.Value & "*" _
    And LCase(Replace(Replace(Cells(i, "E").Value, "I", "ı"), "İ", "i")) Like ComboBox2.Value & "*" _
    And LCase(Replace(Replace(Cells(i, "F").Value, "I", "ı"), "İ", "i")) Like ComboBox3.Value & "*" Then
    
        a = a + 1
        ReDim Preserve myarr(1 To 12, 1 To a)
        For k = 1 To 12
            myarr(k, a) = Cells(i, k).Value
        Next k
        [COLOR="red"][B]toplam=cells(i,11).value+toplam[/B][/COLOR]
        If a = 1 Then
            deg = Cells(i, 10).Value
            ElseIf Cells(i, 10).Value < deg Then
            deg = Cells(i, 10).Value
        End If
    End If
Next i
If a > 0 Then ListBox1.Column = myarr
Erase myarr
Label17.Caption = Format(deg, "#,##0.00") & " " & "YTL'dir"
[COLOR="Red"][B]textbox1.value=format(toplam,"#,##0.00")[/B][/COLOR]

End Sub

 

[udentr2002]

tekrardan çok teşekkür ederim hocam dediğiniz kodları değiştireceğim

 

[Orion1]

tekrardan çok teşekkür ederim hocam dediğiniz kodları değiştireceğim

Rica ederim.
İyi çalışmalar.