Excel VB Listbox'ta süzme işlemi sonrasında toplam alma

[deli çocuk]

Değerli arkadaşlar,

Ekte üreticilerimizde alınan ürünlerin sipariş ve bağlantı tonajlarını takip edebileceğim bir Userform hazırlamaya çalıştım.

Bu formda yer alan Listbox'a Excel sayfasındaki tüm verileri getirip Excel sayfasını hiç kullanmadan kayıt düzeltme , ekleme , silme , süzme ve rakamsal değerler için Listbox altına yerleştirdiğim Textbox'lara toplamları alıyorum .

İçinden çıkamadığım üç konu için sizden destek rica ediyorum ;

- Userform'un sol üst tarafında kalan Textbox'ları süzme işlemi için kullanıyorum. Göreceğiniz başlıklarda yaptığım süzmeler sonucuna göre altta yer alan toplam Textbox'larının toplam değerlerinin süzme sonrası ekranda görünen veriler olarak değişmesi nasıl sağlayabilirim ? ( Süzme işlemi sonrasında dahi ilgili sütunlara ait tüm toplamlar Textbox'larda görünüyor.)

- Diğer sorunum ise ilk süzme Textbox una firma adını yazıp diğer süzme Textbox'larında ilk süzme işlemine gelen verilere göre tekrar süzme yaptırma işlemi nasıl yapabilirim ?

- Son sorum ise Listbox'un veri çektiği Excel sayfasında herhangi bir boş hücre var ise kayıt değiştirme işlemi yapamıyorum ve Listbox 'ta boş olan alana tıkladığımda da hata alıyorum. Bu hataların önüne nasıl geçebilirim ?

Değerli destekleriniz ve ilginiz için şimdiden teşekkür ederim.

İyi çalışmalar

 

[askm]

1. sorunuzuz çözümünü siz yapmışsınız aslında.
Textbox1 için çözüm;
Not: Diğer sonuçların gelmesi için dizini 21 olarak genişletmeniz gerekir.

Private Sub TextBox1_Change()

' ARAMA TEXTBOXLARI İÇİN


Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 16, 1 To 1)
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    If .FilterMode Then .ShowAllData
    Set k = .Range("F1:F65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 16, 1 To a)
            For j = 1 To 16
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("F1:F65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With
For x = 0 To ListBox1.ListCount - 1
        Text35 = CDbl(ListBox1.List(x, 15)) + CDbl(Text35)
        Text36 = CDbl(ListBox1.List(x, 14)) + CDbl(Text36)
        Text29 = CDbl(ListBox1.List(x, 13)) + CDbl(Text29)
        Text30 = CDbl(ListBox1.List(x, 12)) + CDbl(Text30)
        Text31 = CDbl(ListBox1.List(x, 11)) + CDbl(Text31)
Next x

    TextBox35.Text = FormatNumber(Text35, 2)
    TextBox36.Text = FormatNumber(Text36, 2)
    TextBox29.Text = FormatNumber(Text29, 2)
    TextBox30.Text = FormatNumber(Text30, 2)
    TextBox31.Text = FormatNumber(Text31, 2)
End Sub

 

[deli çocuk]

Sayın askm ; ilginiz için öncelikle teşekkür etmek isterim .
Muhtemelen ifademde bir yanlışlık oldu . Süzme işlemi yaptığımda Listbox'a gelen bilgilerin toplamı doğru gelmiyor.

Toplam alanında tüm verilerin toplamları görünmeye devam ediyor.

Toplam alanlarınında süzme işlemi sonrasında Listbox'taki verileri içerecek şekilde değişmesi sağlanabilir mi ?

 

[askm]

Sorunuzu tam olarak anlamadım ama eğer diğer textboxlara değer gelmesini istemiyorsanız
aşağıdaki şekilde içerisini boşaltabilirsiniz.
TextBox41.Text = Empty
TextBox37.Text =Empty
TextBox38.Text = Empty
TextBox39.Text = Empty
TextBox40.Text = Empty

 

[deli çocuk]

Bu arada gözümden kaçan ilettiğiniz hatayı sayenizde fark etmiş oldum . Teşekkürler

 

[deli çocuk]

Şöyle izah etmeye çalışayım , Userformu iç açtığınızda sağ alt tarafta kalan toplam alanlarında verileri görüyorsunuzdur.
Gelen toplamlar 8.200 ile başlayıp sağa doğru 7.100 ile bitiyor.

Ben süzme işlemi yaptığımda da bu toplamlar aynı kalıyor. Süzme işlemine göre toplamların değişmeni sağlamak istiyorum.

 

[askm]

Tamam işte her bir textbox için ayrı ayrı kod yazmanız gerekli. Örneğin ÜRÜN TANIMI yazan textbox1 kodlarını aşağıdaki şekilde değiştirince oluyor. Aynı mantıkla diğerlerini de değiştirmeniz gerekli.

Private Sub TextBox1_Change()

' ARAMA TEXTBOXLARI İÇİN


Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 21, 1 To 1)
With Worksheets("Sayfa1")
    Me.ListBox1.Clear
    If .FilterMode Then .ShowAllData
    Set k = .Range("F1:F65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 21, 1 To a)
            For j = 1 To 21
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("F1:F65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With
For x = 0 To ListBox1.ListCount - 1
        Text35 = CDbl(ListBox1.List(x, 15)) + CDbl(Text35)
        Text36 = CDbl(ListBox1.List(x, 14)) + CDbl(Text36)
        Text29 = CDbl(ListBox1.List(x, 13)) + CDbl(Text29)
        Text30 = CDbl(ListBox1.List(x, 12)) + CDbl(Text30)
        Text31 = CDbl(ListBox1.List(x, 11)) + CDbl(Text31)
           
        Text41 = CDbl(ListBox1.List(x, 16)) + CDbl(Text41)
        Text37 = CDbl(ListBox1.List(x, 17)) + CDbl(Text37)
        Text38 = CDbl(ListBox1.List(x, 18)) + CDbl(Text38)
        Text39 = CDbl(ListBox1.List(x, 19)) + CDbl(Text39)
        Text40 = CDbl(ListBox1.List(x, 20)) + CDbl(Text40)
Next x
    
    TextBox35.Text = FormatNumber(Text35, 2)
    TextBox36.Text = FormatNumber(Text36, 2)
    TextBox29.Text = FormatNumber(Text29, 2)
    TextBox30.Text = FormatNumber(Text30, 2)
    TextBox31.Text = FormatNumber(Text31, 2)
    TextBox41.Text = FormatNumber(Text41, 2)
    TextBox37.Text = FormatNumber(Text37, 2)
    TextBox38.Text = FormatNumber(Text38, 2)
    TextBox39.Text = FormatNumber(Text39, 2)
    TextBox40.Text = FormatNumber(Text40, 2)
End Sub

 

[deli çocuk]

Tamamdır , ben formun initialize olayına eklemiştim bu kodları , çok teşekkür ederim .

Diğer 2 sorun içinde destek olabilirseniz memnun olurum .

 

[deli çocuk]

Arkadaşlar 2. ve 3. sorun için desteğinize ihtiyacım vardır. Destekleriniz için şimdiden teşekkürler.

 

[deli çocuk]

Arkadaşlar , 2. ve 3. sorunun çözümü konusunda desteğinize ihtiyacım bulunmaktadır.
Problemi yeniden özetlemem gerekirse ;

- Üst alanda yer alan arama Textbox'larını birbiri ile entegre etmem gerekli ,

Örneğin ilk Textbox'ta Üretici tanımını süzdüğümde Listbox'a gelen bilgileri diğer Textbox'lar ile kendi içinde süzebilmeliyim.

- Dİğer konu ise Listxbox boş alanına çift tıkladığımda hata alıyorum , ayrıca Excel sayfasında boş hücre var ise ilgili satırda düzenleme yapamıyorum . Bu işlemde hata ile sonlanıyor.

Destekleriniz için şimdiden teşekkürler .