arama hatası kod

[Cengizhantr06]

iyi akşamlar arama yaparken mesala içinde m yazan hepsini buluyor
sonra ismi tam yazınca doğru buluyor sizden isteğim ilk harfi yazına sadece o harfle başlayanları bulsun
Private Sub TextBox1_Change()
Dim sh As Worksheet, son As Long, deg As String, i As Long, sat As Long
Set sh = Sheets("Personeller")
son = Cells(Rows.Count, "B").End(3).Row 'son dolu hücre
Me.ListView1.ListItems.Clear
sat = 1
i = 1
For i = 2 To son
deg = sh.Cells(i, "B").Value
deg = UCase(Replace(Replace(deg, "i", "İ"), "ı", "I"))
If deg Like UCase(Replace(Replace("*" & TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then
ListView1.ListItems.Add , , Sheets("Personeller").Cells(i, 1).Value
ListView1.ListItems(sat).SubItems(1) = Sheets("Personeller").Cells(i, 2).Value
ListView1.ListItems(sat).SubItems(2) = Sheets("Personeller").Cells(i, 3).Value
ListView1.ListItems(sat).SubItems(3) = Sheets("Personeller").Cells(i, 4).Value
ListView1.ListItems(sat).SubItems(4) = Sheets("Personeller").Cells(i, 5).Value
ListView1.ListItems(sat).SubItems(5) = Sheets("Personeller").Cells(i, 6).Value
sat = sat + 1
End If
Next
End Sub

 

[Orion1]

Buyurun.

If deg Like UCase(Replace(Replace(TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then

 

[Cengizhantr06]

Buyurun.

If deg Like UCase(Replace(Replace(TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then

Evren bey çok teşekkür ederim bi ricam daha olsa bu kodları listbox için nasıl uyarlayabiliriz yatırımcı olurmusunuz rica etsem

 

[Orion1]

Örnek dosya eklerseniz daha iyi olacaktır.

 

[Cengizhantr06]

Örnek dosya eklerseniz daha iyi olacaktır.

evren bey textbox1 deki kodları listboxa uyarlamak istiyorum

 

[Orion1]

Buyurun.

Private Sub TextBox1_Change()
Dim sh As Worksheet, son As Long, i As Long
Set sh = Sheets("Personeller")
Me.ListBox1.RowSource = ""
Sheets("Sorgu").Range("A2:F" & Rows.Count).ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter Field:=2, Criteria1:=TextBox1.Value & "*"
sh.Range("a2").CurrentRegion.Copy
Sheets("Sorgu").Range("A1").PasteSpecial
Application.CutCopyMode = False
son = Sheets("Sorgu").Cells(Rows.Count, "B").End(3).Row 'son dolu hücre
ListBox1.RowSource = "Sorgu!A2:F" & son
End Sub

 

[Cengizhantr06]

Buyurun.

Private Sub TextBox1_Change()
Dim sh As Worksheet, son As Long, i As Long
Set sh = Sheets("Personeller")
Me.ListBox1.RowSource = ""
Sheets("Sorgu").Range("A2:F" & Rows.Count).ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter Field:=2, Criteria1:=TextBox1.Value & "*"
sh.Range("a2").CurrentRegion.Copy
Sheets("Sorgu").Range("A1").PasteSpecial
Application.CutCopyMode = False
son = Sheets("Sorgu").Cells(Rows.Count, "B").End(3).Row 'son dolu hücre
ListBox1.RowSource = "Sorgu!A2:F" & son
End Sub

evren bey özür dilerim sorgu sayfasını silmeyi unutmuşum yani sorgu sayfası olmadan tek sayfada yapabilirmiyiz lütfen

 

[Korhan Ayhan]

Deneyiniz.

Private Sub TextBox1_Change()
    Dim S1 As Worksheet, Veri As Variant, Son As Long
    Dim Aranan As String, X As Long, Y As Byte, Say As Long
    
    Set S1 = Sheets("Personeller")
    
    Son = S1.Cells(S1.Rows.Count, "B").End(3).Row
    If Son <= 2 Then Son = 3
    
    Veri = S1.Range("A2:F" & Son).Value
    
    ReDim Liste(1 To 6, 1 To 1)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Aranan = UCase(Replace(Replace(Veri(X, 2), "i", "İ"), "ı", "I"))
        If Aranan Like UCase(Replace(Replace(TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then
            Say = Say + 1
            ReDim Preserve Liste(1 To 6, 1 To Say)
            
            For Y = 1 To 6
                Liste(Y, Say) = Veri(X, Y)
            Next
        End If
    Next

    With Me.ListBox1
        .RowSource = ""
        .ColumnHeads = False
        .ColumnCount = 6
        .ColumnWidths = "50,50,50,70,70,70"
        .Column = Liste
    End With

    Set S1 = Nothing
End Sub

 

[Cengizhantr06]

Deneyiniz.

Private Sub TextBox1_Change()
    Dim S1 As Worksheet, Veri As Variant, Son As Long
    Dim Aranan As String, X As Long, Y As Byte, Say As Long
   
    Set S1 = Sheets("Personeller")
   
    Son = S1.Cells(S1.Rows.Count, "B").End(3).Row
    If Son <= 2 Then Son = 3
   
    Veri = S1.Range("A2:F" & Son).Value
   
    ReDim Liste(1 To 6, 1 To 1)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Aranan = UCase(Replace(Replace(Veri(X, 2), "i", "İ"), "ı", "I"))
        If Aranan Like UCase(Replace(Replace(TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then
            Say = Say + 1
            ReDim Preserve Liste(1 To 6, 1 To Say)
           
            For Y = 1 To 6
                Liste(Y, Say) = Veri(X, Y)
            Next
        End If
    Next

    With Me.ListBox1
        .RowSource = ""
        .ColumnHeads = False
        .ColumnCount = 6
        .ColumnWidths = "50,50,50,70,70,70"
        .Column = Liste
    End With

    Set S1 = Nothing
End Sub

Korhan bey elinize saglık ama arama yapınca column adları kayboluyor ColumHeads true yaptım bu kezde yerleri çıkıyor ama yine adları cıkmıyor bunun bi yolu varmı acaba ?

 

[Korhan Ayhan]

Bu yöntemle Başlık satırı özelliğini kullanamazsınız.

Başlık satırı listeye eklenebilir ama başlık satırı gibi sabit kalmaz. Ya da ListBox üzerine Label ekleyip başlık özelliği verebilirsiniz. Görsel olarak benzer sonucu elde etmiş olursunuz.

Başlık satırı özelliği RowSource metodu için kullanılabilen bir özelliktir.

 

[Cengizhantr06]

Bu yöntemle Başlık satırı özelliğini kullanamazsınız.

Başlık satırı listeye eklenebilir ama başlık satırı gibi sabit kalmaz. Ya da ListBox üzerine Label ekleyip başlık özelliği verebilirsiniz. Görsel olarak benzer sonucu elde etmiş olursunuz.

Başlık satırı özelliği RowSource metodu için kullanılabilen bir özelliktir.

Rowsurce metodu ile bir kod varmı bildiğiniz paylasabilirmisiniz rica etsem Korhan bey

 

[Korhan Ayhan]

#6 nolu mesajda Evren beyin paylaşımı RowSource metoduyla ilgili yöntemdir.