• DİKKAT

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

arama hatası kod

Cengizhantr06

Cengizhantr06

Katılım
16 Mayıs 2020
Mesajlar
327
Excel Vers. ve Dili
Office 365 Türkçe
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
 
Buyurun.

Kod: 
If deg Like UCase(Replace(Replace(TextBox1.Value & "*", "i", "İ"), "ı", "I")) Then
 
Örnek dosya eklerseniz daha iyi olacaktır.
 
Buyurun.
Kod: 
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
 
Orion1' Alıntı:
Buyurun.
Kod: 
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
Genişletmek için tıkla ...
evren bey özür dilerim sorgu sayfasını silmeyi unutmuşum yani sorgu sayfası olmadan tek sayfada yapabilirmiyiz lütfen
 
Deneyiniz.

C++: 
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 Ayhan' Alıntı:
Deneyiniz.

C++: 
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
Genişletmek için tıkla ...
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 ?
 
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.
 
Korhan Ayhan' Alıntı:
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.
Genişletmek için tıkla ...
Rowsurce metodu ile bir kod varmı bildiğiniz paylasabilirmisiniz rica etsem Korhan bey
 
#6 nolu mesajda Evren beyin paylaşımı RowSource metoduyla ilgili yöntemdir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst