Bu dosyada kod kısaltılıp tek sub içine alındı abey.Bence bunu kullanın.
Sub lstboxlar(alan As Byte)
Dim dic As Object, veri, aranan As String
Set dic = CreateObject("Scripting.dictionary")
With Sayfa2
veri = .Range("A2:C" & .Range("A" & Rows.Count).End(3).Row).Value
End With
If alan = 1 Then 'userform acilis ve Listbox1 icin
For i = LBound(veri) To UBound(veri)
aranan = veri(i, 1)
If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
Next
With Me.ListBox1
.Clear: If dic.Count > 0 Then .List = dic.keys: TextBox1.SetFocus
End With
ElseIf alan = 2 Then 'Listbox2 ye veri almak icin
For i = LBound(veri) To UBound(veri)
aranan = veri(i, 2)
If veri(i, 1) = ListBox1.Value Then _
If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
Next
With Me.ListBox2
.Clear: Me.ListBox3.Clear: If dic.Count > 0 Then .List = dic.keys
End With
ElseIf alan = 3 Then 'Listbox2 ye veri almak icin
For i = LBound(veri) To UBound(veri)
aranan = veri(i, 3)
If veri(i, 1) & "|" & veri(i, 2) = ListBox1.Value & "|" & ListBox2.Value Then
If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
End If
Next
With Me.ListBox3
.Clear: If dic.Count > 0 Then .List = dic.keys
End With
ElseIf alan = 4 Then 'textbox arama icin
For i = LBound(veri) To UBound(veri)
aranan = veri(i, 1)
If LCase(veri(i, 1)) Like "*" & LCase(TextBox1.Value) & "*" Then _
If Not dic.exists(aranan) Then If Not dic.exists(aranan) And aranan <> "" Then dic.Add aranan, ""
Next
With Me.ListBox1
.Clear: If dic.Count > 0 Then .List = dic.keys
End With
End If
Set dic = Nothing: Erase veri
End Sub
Private Sub UserForm_Initialize()
Call lstboxlar(1)
End Sub
Private Sub ListBox1_Click()
Call lstboxlar(2)
End Sub
Private Sub ListBox2_Click()
Call lstboxlar(3)
End Sub
Private Sub TextBox1_Change()
Call lstboxlar(4)
End Sub
Kitap11.rar
(Dosya Boyutu: 1,96 MB | İndirme Sayısı: 3)