Listbox da Süzme İşleminde Yavaşlama?

[udentr2002]

Merhabaarkadaşlar sayfamda 1000 satır dan fazla veri girişi mevcut bu verileri forumda 11 stünluk listboxa alıyorum ve textboxun change özelliğine yazılan koda göre listboxda süzme işlemi yapıyorum yanlız veri girişim arttıkça textboxa süzme yapabilmek için yazı yazmaya başlayınca yavaşlama ve donma oluyor textboxun change olayına yazdığım kodlar aşağıdadır bu yavaşlamanın sebebi nedir çözemedim bunu engelleyebilmem için ne yapabilirim

Private Sub TextBox15_Change()

On Error Resume Next
For X = 4 To 14
Controls("textbox" & X).Value = ""
Next
ListBox1.RowSource = Empty
ListBox1.Clear
ListBox1.ColumnCount = 11
For Each isim In Sheets("Veri").Range("a3:a" & Sheets("Veri").Range("a65536").End(3).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox15)) & "*" Then
   isim.Select
liste = ListBox1.ListCount
ListBox1.AddItem
ListBox1.List(liste, 0) = isim
ListBox1.List(liste, 1) = isim.Offset(0, 1)
ListBox1.List(liste, 2) = isim.Offset(0, 2)
ListBox1.List(liste, 3) = isim.Offset(0, 3)
ListBox1.List(liste, 4) = isim.Offset(0, 4)
ListBox1.List(liste, 5) = isim.Offset(0, 5)
ListBox1.List(liste, 6) = isim.Offset(0, 6)
ListBox1.List(liste, 7) = isim.Offset(0, 7)
ListBox1.List(liste, 8) = isim.Offset(0, 8)
ListBox1.List(liste, 9) = isim.Offset(0, 9)
ListBox1.List(liste, 10) = isim.Offset(0, 10)
ListBox1.List(liste, 11) = isim.Offset(0, 11)
   TextBox4 = ActiveCell.Offset(0, 0).Value
  TextBox5 = ActiveCell.Offset(0, 1).Value
  TextBox6 = ActiveCell.Offset(0, 2).Value
   TextBox7 = ActiveCell.Offset(0, 3).Value
   TextBox8 = ActiveCell.Offset(0, 4).Value
   TextBox9 = ActiveCell.Offset(0, 5).Value
   TextBox10 = ActiveCell.Offset(0, 6).Value
   TextBox11 = ActiveCell.Offset(0, 7).Value
   TextBox12 = ActiveCell.Offset(0, 8).Value
   TextBox13 = ActiveCell.Offset(0, 9).Value
   TextBox14 = ActiveCell.Offset(0, 10).Value
End If
Next
If TextBox15.Text = "" Then
For X = 4 To 14
Controls("textbox" & X) = ""
Next
End If
For X = 4 To 14
If Controls("textbox" & X).Text = "" Then
Controls("textbox" & X).BackColor = vbWhite
Else
Controls("textbox" & X).BackColor = vbBlue
Controls("textbox" & X).ForeColor = vbWhite
End If
Next
End Sub

textboxa harf girerken donuyor yada textboxda yazıan veriyi space tuşu ile silmeye başlarkende donuyor bu veri sayım arttınca olmaya başladı verilerin sayısı az iken böyle bir şey yoktu.

Şimdiden ilgilenen tüm arkadaşlarıma teşekkür ederim

 

[Ferhat Pazarçevirdi]

Textbox'ı her değiştirdiğinizde (bir harf girdiğinizde) dünya yeniden kuruluyor.

Kodları Textbox'ın change olayına değil, yeni eklyeceğiniz bir commandbutton'un click olayına atayabilirsiniz. Böylelikle, Textbox son şeklini aldığında listbox yüklenmiş olur.

 

[hsayar]

Private Sub TextBox15_Exit() olayına atamakta çözüm olabilir bence

 

[udentr2002]

hocam change olayına yazmamın sebebi her harfi girmeye başlayınca o harfle başlayanları süzmeye başlaması amacı ile idi buton ile değilde change olayı daha kullanışlı geliyor o yüzden kodu change olayına yazdım ama bu defada liste çoğalınca sorun yaratmaya başladı change olayındayken bir şey yapabilmemizin imkanı varmı acaba?

 

[Ferhat Pazarçevirdi]

O zaman kodlarınızda aşağıdaki gibi bir değişiklik yapabilirsiniz. Gerçi, projenizdeki yavaşlama bundan mı kaynaklanıyor veya ne kadarı bundan kaynaklanıyor bilemiyoorum ama bir rahatlama sağlayacağı kesin.

Listbox'a yükleme yaparken hücreleri tek tek sayfa üzerinde aktif hale getirmektesiniz. Bu genel anlamda kodların çalışmasını yavaşlatır.

Listbox'a yükleme için aşağıdaki yapıyı kendinize adapta ediniz.

Dim arrVeri()
'.....
'.....
For Each isim In Sheets("Veri").Range("a3:a" & Sheets("Veri").Range("a65536").End(3).Row)
    If UCase(LCase(isim)) Like UCase(LCase(TextBox15)) & "*" Then
           y = y + 1
           ReDim Preserve arrVeri(1 To 11, 1 To y)
           For i = 1 To 11
                  arrVeri(i, y) = isim.Offset(0, i - 1)
           Next i
        End If
    Next
With listbox1
    .RowSource = Empty
    .Clear
    .ColumnCount = 11
    .List = Application.WorksheetFunction.Transpose(arrVeri)
End With
'.....
'.....

 

[udentr2002]

Hocam çok teşekkür ederim. Gönderdiğiniz kodlar gayet güzel çalışıyor.

Sizden bir şey daha rica edeceğim eğer mümkünse tabi;

listboxda süzme yaparken ben bulunan kayıtları textboxlara aktarıyordum aşağıdaki kodlar yardımı ile ;

TextBox4 = ActiveCell.Offset(0, 0).Value
  TextBox5 = ActiveCell.Offset(0, 1).Value
  TextBox6 = ActiveCell.Offset(0, 2).Value
   TextBox7 = ActiveCell.Offset(0, 3).Value
   TextBox8 = ActiveCell.Offset(0, 4).Value
   TextBox9 = ActiveCell.Offset(0, 5).Value
   TextBox10 = ActiveCell.Offset(0, 6).Value
   TextBox11 = ActiveCell.Offset(0, 7).Value
   TextBox12 = ActiveCell.Offset(0, 8).Value
   TextBox13 = ActiveCell.Offset(0, 9).Value
   TextBox14 = ActiveCell.Offset(0, 10).Value

sizin göndermiş olduğunuz kodları kullanarak süzülen veriyi textboxlara aktarma işlemi yapabilirmiyiz acaba?
sizin gönderdiğiniz kodları kullanarak benim

 

[Ferhat Pazarçevirdi]

Listbox'ta sonuca uyan bir çok veri listeleniyor.

Textbox'a ne yüklenecek ? Listboxın ilk satırı mı?

 

[udentr2002]

Evet hocam ilk satırıda olabilir

 

[Ferhat Pazarçevirdi]

TextBox4.... TextBox14 arasını doldurmak için; aşağıdaki gibi bir kod kullabilirsiniz.

Dim i As Integer
'....
For i = 1 To 11
    Me.Controls("Textbox" & i + 3) = arrveri(i, 1)
Next i
'.....

 

[udentr2002]

Hocam çok teşekkür ederim kodlarınızı kullanarak sorunumu çözdüm ellerinize sağlık. sadece son bir şey var
süzme işlemini yaparken dikkat ettimde I ve i harflerinde sorun yapıyor hocam türkçe karakterlere uyum için ne yapabilirim