• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listboxta filitreme

Katılım
13 Temmuz 2016
Mesajlar
613
Excel Vers. ve Dili
Excel 2010 & 2016 Türkçe
Arkadaşlar Hayırlı Akşamlar Aşağıdaki kodla Klasör içindeki word dosyalarını listboxta sıralıyorum Yapmak istediğim Texbox1 ile yazacağım veri Listboxta listelensin Örnek olarak Textbox1 A yazsam a ile başlayan veriler listboxta sıralansın ve bulsun
Kod:
Private Sub UserForm_Initialize()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
For Each dosya In dc
If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 Then _
If InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then ListBox1.AddItem ds.GetBaseName(dosya)
Next
End Sub
 
Son düzenleme:
Merhaba
Aynı kodlara eklemeler yaparak listeleyebiliriniz.
Kod:
 [SIZE="2"][COLOR="Red"]Private Sub TextBox1_Change[/COLOR]()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
[COLOR="Red"]ListBox1.Clear[/COLOR]
For Each dosya In dc
[COLOR="Red"]If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 And InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then
If UCase(ds.GetBaseName(dosya)) Like UCase(TextBox1) & "*" Then ListBox1.AddItem ds.GetBaseName(dosya)[/COLOR]
End If
Next
End Sub [/SIZE]
 
Merhaba
Aynı kodlara eklemeler yaparak listeleyebiliriniz.
Kod:
 [SIZE="2"][COLOR="Red"]Private Sub TextBox1_Change[/COLOR]()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
[COLOR="Red"]ListBox1.Clear[/COLOR]
For Each dosya In dc
[COLOR="Red"]If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 And InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then
If UCase(ds.GetBaseName(dosya)) Like UCase(TextBox1) & "*" Then ListBox1.AddItem ds.GetBaseName(dosya)[/COLOR]
End If
Next
End Sub [/SIZE]

Öncelikle ilginizden dolayı teşekkür ederim. Aşağıdaki kodlarla konu çözüldü
Kod:
 Dim sFind As String
     
    sFind = Me.TextBox1.Text
     
    If Len(sFind) = 0 Then
        Me.ListBox1.ListIndex = -1
        Me.ListBox1.TopIndex = 0
    Else
        For i = 0 To Me.ListBox1.ListCount - 1
           If InStr(UCase(ListBox1.List(i)), UCase(sFind)) > 0 Then
                Me.ListBox1.TopIndex = i
                Me.ListBox1.ListIndex = i
                Exit For
            End If
        Next i
    End If
 
Son düzenleme:
Geri
Üst