textbox ile süzme

[cetinsin]

textboxla listboxtaki bilgileri aşağıdaki kodla süzüyorum. ancak listboxta bulamadığım zaman hataya geçiyor. aradığınız kriterde kayıt bulunamadı şeklinde uyarı nasıl verdirebilirim.

Private Sub TextBox11_Change()
Dim arrVeri()
'.....
'.....
For Each isim In Sheets("data").Range("b2:b" & Sheets("data").Range("a65536").End(3).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox11)) & "*" Then
y = y + 1
ReDim Preserve arrVeri(1 To 1, 1 To y)
For i = 1 To 1
arrVeri(i, y) = isim.Offset(0, i - 1)
Next i
End If
Next
With ListBox1
.RowSource = Empty
.Clear
.ColumnCount = 1
.List = Application.WorksheetFunction.Transpose(arrVeri)
End With
'.....
'.....
TextBox11.Text = UCase(TextBox11.Text)

End Sub

 

[halit3]

dosyanızı ekleyiniz bir bakalım

 

[cetinsin]

dosyanızı ekleyiniz bir bakalım

dosyayı ekledim. yardımlarıniçin şimdiden teşekkürler.

 

[Ferhat Pazarçevirdi]

Kodunuzun ilgili kısmını, şu şekilde değiştiriniz ...

'.....
With ListBox1
    .RowSource = Empty
    .Clear
    .ColumnCount = 1
    If y > 0 Then
        .List = Application.WorksheetFunction.Transpose(arrVeri)
    Else
        MsgBox "Kriter uygun kayıt yok", vbInformation, "Bilgilendirme"
    End If
End With
'.......

.

 

[cetinsin]

Kodunuzun ilgili kısmını, şu şekilde değiştiriniz ...

'.....
With ListBox1
    .RowSource = Empty
    .Clear
    .ColumnCount = 1
    If y > 0 Then
        .List = Application.WorksheetFunction.Transpose(arrVeri)
    Else
        MsgBox "Kriter uygun kayıt yok", vbInformation, "Bilgilendirme"
    End If
End With
'.......

.

hocam çok teşekkür ederim yardımınız için bu doyayla alakalı birşey daha sorsam. listbox da çift tıklayarak o kaydın bilgilerini textboxlara yazıyorum ama süzme işlemini yaptıktan sonra
kaydın üzerine çift tıkladığımda benim istediğim kayıtları değilde data sayfasında ki başka bir kaydı getiriyor. aslında mantık olarak yapmam gerektiğini biliyorum ama nasıl yapacağımı bilmiyorum. yardımcı olursanız sevinirim

 

[Ferhat Pazarçevirdi]

ListBox1'in Double_Click olay kodlarını şu şekilde dizayn ediniz ... Eklenen yeni komutlar, kırmızı renk ile göstewrilmiştir ...

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
[COLOR=red]    Dim rng As Range[/COLOR]
    
[COLOR=red]    If ListBox1.ListCount = 0 Then Exit Sub[/COLOR]
    
    Yeni_Mi = False
[COLOR=red]    Set rng = Sheets("Data").Columns(2).Find(ListBox1, Lookat:=xlWhole)
    
    If Not rng Is Nothing Then
        
        bulunan_satir_no = rng.Row[/COLOR]
    
        TextBox1.Text = Sheets("Data").Range("B" & bulunan_satir_no).Value
        TextBox2.Text = Sheets("Data").Range("C" & bulunan_satir_no).Value
        TextBox3.Text = Sheets("Data").Range("D" & bulunan_satir_no).Value
        ComboBox1.Text = Sheets("Data").Range("F" & bulunan_satir_no).Value
        ComboBox2.Text = Sheets("Data").Range("G" & bulunan_satir_no).Value
        TextBox6.Text = Sheets("Data").Range("E" & bulunan_satir_no).Value
        TextBox7.Text = Sheets("Data").Range("h" & bulunan_satir_no).Value
        TextBox8.Text = Sheets("Data").Range("I" & bulunan_satir_no).Value
        TextBox9.Text = Sheets("Data").Range("J" & bulunan_satir_no).Value
        TextBox10.Text = Sheets("Data").Range("K" & bulunan_satir_no).Value
    
[COLOR=red]    End If
    
    Set rng = Nothing[/COLOR]
    
End Sub

 

[cetinsin]

ListBox1'in Double_Click olay kodlarını şu şekilde dizayn ediniz ... Eklenen yeni komutlar, kırmızı renk ile göstewrilmiştir ...

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
[COLOR=red]    Dim rng As Range[/COLOR]
    
[COLOR=red]    If ListBox1.ListCount = 0 Then Exit Sub[/COLOR]
    
    Yeni_Mi = False
[COLOR=red]    Set rng = Sheets("Data").Columns(2).Find(ListBox1, Lookat:=xlWhole)
    
    If Not rng Is Nothing Then
        
        bulunan_satir_no = rng.Row[/COLOR]
    
        TextBox1.Text = Sheets("Data").Range("B" & bulunan_satir_no).Value
        TextBox2.Text = Sheets("Data").Range("C" & bulunan_satir_no).Value
        TextBox3.Text = Sheets("Data").Range("D" & bulunan_satir_no).Value
        ComboBox1.Text = Sheets("Data").Range("F" & bulunan_satir_no).Value
        ComboBox2.Text = Sheets("Data").Range("G" & bulunan_satir_no).Value
        TextBox6.Text = Sheets("Data").Range("E" & bulunan_satir_no).Value
        TextBox7.Text = Sheets("Data").Range("h" & bulunan_satir_no).Value
        TextBox8.Text = Sheets("Data").Range("I" & bulunan_satir_no).Value
        TextBox9.Text = Sheets("Data").Range("J" & bulunan_satir_no).Value
        TextBox10.Text = Sheets("Data").Range("K" & bulunan_satir_no).Value
    
[COLOR=red]    End If
    
    Set rng = Nothing[/COLOR]
    
End Sub

hocam komutları değiştirdim ama çift tıklamayla txboxlara bilgiler gelmiyor. listenin tamamı varkende bilgiler gelmiyor

 

[Ferhat Pazarçevirdi]

Herhalde dosyanıza adapte ederken bir hata yapmış olmalısınız ... Aynı kodları içeren, dosyayı ekte gönderiyorum. İnceleyiniz.

Hem süzme olmadan hem de süzdükten sonra ListBox'a çift tıklayınız .. TextBoxlara seçilen kayıt gelecektir.


.

 

[halit3]

bende sizin dosyanıza bir tane listbox ekledim ve textbox11 den alfabetik seçtiğiniz kişilerin isimleri aynı olursa ayırması için bu uygulamayı yaptım kontrol ediniz.

 

[cetinsin]

Herhalde dosyanıza adapte ederken bir hata yapmış olmalısınız ... Aynı kodları içeren, dosyayı ekte gönderiyorum. İnceleyiniz.

Hem süzme olmadan hem de süzdükten sonra ListBox'a çift tıklayınız .. TextBoxlara seçilen kayıt gelecektir.


.

hocam çok teşekkürler. kendi dosyama adapte ederken hata yapmamışım ama listbox ın özelliklerinden bazılarını değiştirmişim o yüzden olmuyormuş.
birde ben bu dosyada bilgi girişi yaparken sadece ismi aynı olanlar için mükerrer kayıt kontrolü yapıyorum okul içinde yapmak istesem nasıl yapabilirim. örn. 1.kaydım
cetinsin atatürk lisesi olsun 2.kaydım cetinsin cumhuriyet lisesi olduğunda yeni kayıt olsun cetinsin atatürk olduğunda uyarı versin. benim yaptığımda sadece cetinsin gördüğünde uyarı veriyor.

 

[cetinsin]

bende sizin dosyanıza bir tane listbox ekledim ve textbox11 den alfabetik seçtiğiniz kişilerin isimleri aynı olursa ayırması için bu uygulamayı yaptım kontrol ediniz.

yardımların için çok teşekkürler. ancak ben zaten aynı isimde kayıt yaptırmıyorum mükerrer kayıt uyarısı veriyor