Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: kelkitli - 16 Ocak 2011, 09:45:51

Başlık: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 16 Ocak 2011, 09:45:51

Selamlar,
UserForm da TextBoxlarımız ve bir de Listview imiz var. TextBox1 e yazılan harfe göre listeleme yapmak istiyorum. Bir harf daha yazılınca yeniden.  Şu kodla Listviewde arama listeleme yapıyorum. Ancak Change olayına harf girince listeleme yapamadım.

Kod: [Seç]

Private Sub Textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' TEXTBOX İÇİNDE ARAMA YAPAR
If KeyCode <> 13 Then Exit Sub
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("İSİM")
ara = TextBox1.Value
    Set bulunacak = Sh.Range("A:A").Find(ara) 'VERİ HANGİ SÜTUNDA ARANACAK
    If Not bulunacak Is Nothing Then
       Adres = bulunacak.Address
       ListView1.ListItems.Clear
       Do
            SAT = bulunacak.Row
            With ListView1
               .ListItems.Add , , Sh.Cells(SAT, 1)
                X = X + 1
                With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
                     .Add , , Sh.Cells(SAT, 2)
                     .Add , , Sh.Cells(SAT, 3)
                     .Add , , Sh.Cells(SAT, 4)
                     .Add , , Sh.Cells(SAT, 5)
                     .Add , , SAT
                End With
            End With
            Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
        Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
    Else
        MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
        TextBox1.Value = ""
        ListeGuncelle
    End If
End Sub

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: Bülent Öztürk - 16 Ocak 2011, 17:42:14

Merhaba Necmettin Bey.

Örnek dosya üzerinde sormanız mümkün müdür?

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 17 Ocak 2011, 00:12:11

Selamlar,
Dosya ektedir.

http://s3.dosya.tc/file/CsztNy/dosya.rar.html

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: Bülent Öztürk - 17 Ocak 2011, 13:59:52

Aleyküm Selam.

Textbox1'in Change olayına ait kodları aşağıdaki gibi değiştirin:

Alıntı

Private Sub TextBox1_Change()
TextBox1 = Evaluate("=UPPER(" & """" & TextBox1 & """" & ")")
' TEXTBOX İÇİNDE ARAMA YAPAR
'If KeyCode <> 13 Then Exit Sub
On Error Resume Next
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("İSİM")
ara = TextBox1.Value
    Set bulunacak = Sh.Range("A:A").Find(ara) 'VERİ HANGİ SÜTUNDA ARANACAK
    If Not bulunacak Is Nothing Then
       Adres = bulunacak.Address
       ListView1.ListItems.Clear
       Do
            sat = bulunacak.Row
            With ListView1
               .ListItems.Add , , Sh.Cells(sat, 1)
                X = X + 1
                With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
                     .Add , , Sh.Cells(sat, 2)
                     .Add , , Sh.Cells(sat, 3)
                     .Add , , Sh.Cells(sat, 4)
                     .Add , , Sh.Cells(sat, 5)
                     .Add , , sat
                End With
            End With
            Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
        Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
    Else
        MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
        TextBox1.Value = ""
        ListeGuncelle
    End If

If TextBox1 = "" Then ListeGuncelle
End Sub

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 17 Ocak 2011, 16:34:58

Bülent Bey,
veriler çoğalınca süzmede problem oldu. Mesela A yazdığımda B ile ve daha başka harflerle başlayan isimler de listelendi.

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: Bülent Öztürk - 17 Ocak 2011, 16:48:16

İlgili komut satırını aşağıdaki gibi değiştirip dener misiniz?

Kod: [Seç]

Set bulunacak = Sh.Range("A:A").Find(ara & "*", LookAt:=xlWhole) 'VERİ HANGİ SÜTUNDA ARANACAK

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 17 Ocak 2011, 18:56:44

Teşekkürler Üstad,
ellerine sağlık.

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 18 Ocak 2011, 17:44:44

Üstad sonradan şöyle bir olumsuzluk farkettim. Harfe göre listeleme yapıyor ama listviewden çift tıklayıp textboxlara veri almak isteyince sadece textbox1 e veri alıyor.

Başlık: Ynt: Listview de tektbox a yazılan harfe göre süzme
Gönderen: kelkitli - 18 Ocak 2011, 21:49:51

Değerli Dostlar Selamlar,
Sorunu çözdüm. kodlar Change olayında yazılı olduğundan, listviewe tıklayıp verileri textboxlara alınca cange olayı yeniden aktif oluyor ve sonuç alınamıyordu. KeyUp kısmına yazınca sorun düzeldi.

Kod: [Seç]

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' TEXTBOX İÇİNDE ARAMA YAPAR
'If KeyCode <> 13 Then Exit Sub
On Error Resume Next
If Trim(TextBox1.Value) = "" Then: ListeGuncelle: Exit Sub
Set Sh = Sheets("İSİM")
ara = TextBox1.Value
    Set bulunacak = Sh.Range("A:A").Find(ara & "*", LookAt:=xlWhole) 'VERİ HANGİ SÜTUNDA ARANACAK
    If Not bulunacak Is Nothing Then
       Adres = bulunacak.Address
       ListView1.ListItems.Clear
       Do
            sat = bulunacak.Row
            With ListView1
               .ListItems.Add , , Sh.Cells(sat, 1)
                X = X + 1
                With .ListItems(X).ListSubItems
' LISTVIEW İÇİNDE SAHA FAZLA İSE İLAVE EDİN
                     .Add , , Sh.Cells(sat, 2)
                     .Add , , Sh.Cells(sat, 3)
                     .Add , , Sh.Cells(sat, 4)
                     .Add , , Sh.Cells(sat, 5)
                     .Add , , sat
                End With
            End With
            Set bulunacak = Sh.Range("A:A").FindNext(bulunacak)
        Loop While Not bulunacak Is Nothing And bulunacak.Address <> Adres
    Else
        'MsgBox "Aradığınız kritere uygun veri bulunamadı", vbCritical, "ARAMA SONUCUNDA HATA"
        'TextBox1.Value = ""
        ListeGuncelle
    End If[/color][/color]