ListBox'ı ComboBoxtaki veriye göre süzme

[kinikemrah]

Ekli dosyayı görüntüle 170452Merhaba,
bir çok forumda dolaşarak ekteki excel çalışmasını oluşturdum.

bir çok noktada takıldım belki sizler için çok kısa sürecek sorunları saatlerce uğraşarak bu hale getirdim.

Öncelikle adım adım sıkıntılarımdan bahsedeyim.

Combobox daki herhangi bir değere göre listbox'ı süzmek istiyorum. aslında kısmi olarak yaptım daha önce yapılanlardan örnek alarak kendime uyarladım ama bu sefer 13 hücreli listboxtan sadece 4 hücresi görünüyor ve nasıl hepsinin görünmesini sağlayacğımı bilemiyorum. ayrıca comboboxa veri giriş yapıp sildiğimde hata kodu alıyorum. ama sıralama kodları nasıl yazılıyor mantığını anlayamadığım için tıkandım.
kodlar şöyle
Private Sub ComboBox1_Change()
'On Error Resume Next
Dim k As Range, a As Long, j As Integer, ilk_adres As String
ListBox1.RowSource = vbNullString
ReDim myarr(1 To 4, 1 To 1)
Set k = Range("B2:B65536").Find("*" & ComboBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then

ilk_adres = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 4, 1 To a)
For j = -1 To 1
myarr(j + 2, a) = k.Offset(0, j).Value
Next j
myarr(4, a) = k.Row
Set k = Range("B2:B65536").FindNext(k)
Loop While k.Address <> ilk_adres And Not k Is Nothing
ListBox1.Column = myarr
liste = ListBox1.List
ListBox1.List = sirala(liste)
End If
End Sub


Function sirala(liste)
Dim i As Long, j As Long, x As Variant, k As Byte
For i = 0 To UBound(liste) - 1
For j = i + 1 To UBound(liste)
If liste(i, 0) > liste(j, 0) Then
For k = 0 To 3
x = liste(i, k)
liste(i, k) = liste(j, k)
liste(j, k) = x
Next k
End If
Next j
Next i
sirala = liste
End Function

ayrıca bu sıralamayı yaptım yapalı yavaşlığın nedenini bulamadım userform geç açılmaya başladı.
Formülü sadece şimdilik arackayit userformdaki combobox1 e uyguladım düzgün çalışsa diğerlerine ben uygulayabilirim.

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

Emrah K.

 

[kinikemrah]

Ayrıca zamanınız olursa genel olarak kodları ve nasıl çalıştıklarınıza bakıp bana önerilerde bulunursanız öğretici güzel bir konu olup birçok kişiye cevap olacağını düşünüyorum.

Saygırımla

Emrah K.

 

[kinikemrah]

Merhaba. Zaman ayırabilecek birileri olursa çok sevinirim. Sonuçta bu işte gerçekten çok tecrübeli bilgili arkadaşlar olduğunu görüyor ve biliyorum. Acaba takip edilemedi mi herhangi bir yardım yada cevap gelmedi.

 

[kinikemrah]

Konuyu Güncel tutmak için mesj atıyorum hala bir yardım alamadım. Yardım alma ve verme konusunda bir zorunluluk yok ama nedense üzgün hissetmeye başladım.

Herkese iyi çalışmalar...

 

[kinikemrah]

Tekrar Merhaba,
Sorunun çözümünü acemice buldum. deneme yanılma yöntemi ile pekte anlamadan. Yine acemice paylaşmak istedim. Yanlışım varsa düzeltilmesini rica ederim.

Private Sub ComboBox1_Change()
'On Error Resume Next
Dim k As Range, a As Long, j As Integer, ilk_adres As String
ListBox1.RowSource = vbNullString
ReDim myarr(1 To 4, 1 To 1)
Set k = Range("B2:B65536").Find("*" & ComboBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then

ilk_adres = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 4, 1 To a) 'Burada 1 To 4 List boxta arama yapılırken kaç sutünün görünmesini istiyoruz onu belirtiyoruz.
For j = -1 To 1 'burada arama yaptığımız hücre 0 olmak üzere kaç gerisi ve kaç ileri sutün görünsün sırasını belirtiyoruz.
myarr(j + 2, a) = k.Offset(0, j).Value '(J+2 deki 2 ise kaçıncı sütünda arama yapıyorsak onu yazıyoruz
Next j
myarr(4, a) = k.Row ' (buradaki 4 de karşılık gelen -1 e denk gelen sütündaki değerden bir sonraki çıkıyor bunu anlamadım ama ben 13 sütünlu listboxda 13 yaptım ki son sütünda görünsün.(Yok edemediğimden)
Set k = Range("B2:B65536").FindNext(k)
Loop While k.Address <> ilk_adres And Not k Is Nothing
ListBox1.Column = myarr
liste = ListBox1.List
ListBox1.List = sirala(liste)
End If
End Sub
Dosyayı yeniledim şoför yeni kayıt userformunda Araçları Listele de gizli ComboBoxlarda.
Emrah K.