Listbox ta Filtreleme

Katılım
14 Ağustos 2009
Mesajlar
13
Excel Vers. ve Dili
Microsoft Office 2007- İngilizce
Mehaba,
Oluşturduğum listboxta filtreleme yapmak için SEARCH Textbox ı koydum ama yazdığım kodda (Daha doğrusu alıntı yaptığım ve uyarlamaya çalıştığım kod diyelim:D ) bir poblem var çözemedim. Kodu buraya yazıyorum ve ilgilenecek arkadaşlar için ayıca dosyayı da ekliyorum. Teşekkürler...
Kod:
Private Sub TextBox24_Change()
Dim sat, s As Integer
Dim deg1, deg2 As String
With ListBox1
.Clear
.ColumnCount = 21
.ColumnWidths = "20;120;50;1;110;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60;60"
End With
For sat = 2 To Cells(65536, "a").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(sat, "b"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(Cells(sat, "c"), "ı", "I"), "i", "İ"))
deg3 = UCase(Replace(Replace(Cells(sat, "d"), "ı", "I"), "i", "İ"))
deg4 = UCase(Replace(Replace(Cells(sat, "e"), "ı", "I"), "i", "İ"))
deg5 = UCase(Replace(Replace(Cells(sat, "f"), "ı", "I"), "i", "İ"))
deg6 = UCase(Replace(Replace(Cells(sat, "g"), "ı", "I"), "i", "İ"))
deg7 = UCase(Replace(Replace(TextBox24, "ı", "I"), "i", "İ"))

If deg1 Like "*" & deg7 & "*" _
Or deg2 Like "*" & deg7 & "*" _
Or deg3 Like "*" & deg7 & "*" _
Or deg4 Like "*" & deg7 & "*" _
Or deg5 Like "*" & deg7 & "*" _
Or deg6 Like "*" & deg7 & "*" _
Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "a")
ListBox1.List(s, 1) = Cells(sat, "b")
ListBox1.List(s, 2) = Cells(sat, "c")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")

s = s + 1

End If: Next
End Sub
 

Ekli dosyalar

Son düzenleme:

Orion1

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

Ofis-2010-TR 32 Bit
Listbox'a additem metodu ile en fazla 10 kolon veri alabilirsiniz.
Daha fazla veri almak için Dizi yöntemini veya rowsource yöntemini kullanmalısınız.
Hem bu yöntemler additem metoduna göre çok hızlı sayılırlar.Tavşanla tospaa gibi.:D
 
Katılım
14 Ağustos 2009
Mesajlar
13
Excel Vers. ve Dili
Microsoft Office 2007- İngilizce
Çok teşekkür ederim ancak birkaç soum daha olacak. Dizi yöntemi derken aşağıda yaptığım mıdır?
Bu kodu daha önce denemiştim olmamıştı ama başka bir kod için References ten Microsoft Data Access Components Installed Version u aktifleştirdikten bir süre sonra (yani az önce:)) bu kodu tekrar denedim çalışmaya başladı. Acaba onunla bir ilgisi var mıdır, yoksa sadece rastlantı mıdır bilen var mı acaba?

Bir de kodda(hatta programda) bir açık ya da hataya meyil verebilecek birşeyler farkeden varsa lütfen söylesin çünkü işyerinden 6 aylığına ayrılmam gerekiyor ve bu programı excel bilmeyen arkadaşlar kullanacak.
Kusura bakmayın çok oldu biraz farkındayım affınıza sığınıyorum...

Private Sub TextBox24_Change()
Dim i As Long, k As Byte, a As Long
ListBox1.RowSource = vbNullString
ReDim erey(1 To 21, 1 To 1)

For i = 2 To Cells(65536, "A").End(xlUp).Row
deg1 = UCase(Replace(Replace(Cells(i, "b"), "i", "I"), "i", "I"))
deg2 = UCase(Replace(Replace(Cells(i, "c"), "i", "I"), "i", "I"))
deg3 = UCase(Replace(Replace(Cells(i, "d"), "i", "I"), "i", "I"))
deg4 = UCase(Replace(Replace(Cells(i, "e"), "i", "I"), "i", "I"))
deg5 = UCase(Replace(Replace(Cells(i, "f"), "i", "I"), "i", "I"))
deg6 = UCase(Replace(Replace(Cells(i, "g"), "i", "I"), "i", "I"))
deg7 = UCase(Replace(Replace(TextBox24, "i", "I"), "i", "I"))


If deg1 Like "*" & deg7 & "*" _
Or deg2 Like "*" & deg7 & "*" _
Or deg3 Like "*" & deg7 & "*" _
Or deg4 Like "*" & deg7 & "*" _
Or deg5 Like "*" & deg7 & "*" _
Or deg6 Like "*" & deg7 & "*" _
Then
a = a + 1
ReDim Preserve erey(1 To 21, 1 To a)
For k = 1 To 21
erey(k, a) = Cells(i, k)
Next k
End If
Next i
If a > 0 Then ListBox1.Column = erey
Erase erey
End Sub
 

Orion1

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

Ofis-2010-TR 32 Bit
Evet bahsettiğm yöntemleden biri budur.Yaptığınız aktifleştirme ile ilgili kodun çalışması arasında bir bağ olacağını sanmıyorum.Sanırım daha önce başka bir yerinde hata yapmışsınızdır.:cool:
 
Üst