Soru Kodda revize listbox uyarlama

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
Kod:
Dim Veri As Variant, x As Long, son As Long, Aranan As String, Say As Long
  
Application.ScreenUpdating = 0
If Me.OptionButton1 = True Then sut = 3
If Me.OptionButton2 = True Then sut = 2
If Me.OptionButton3 = True Then sut = 4

If TextBox1 <> "" Then
    son = Sheets("Giris").Cells(Rows.Count, 1).End(3).Row
    If son < 3 Then son = 3
    Veri = Sheets("Giris").Range("A2:I" & son).Value
    Aranan = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*"
    With girenstok.ListView1
        .ListItems.Clear
        For x = LBound(Veri, 1) To UBound(Veri, 1)
            If UCase(Replace(Replace(Veri(x, sut), "ı", "I"), "i", "İ")) Like "*" & Aranan & "*" Then
                .ListItems.Add , , Veri(x, 1)
                Say = Say + 1
                With .ListItems(Say).ListSubItems
                    .Add , , Veri(x, 2)
                    .Add , , Veri(x, 3)
                    .Add , , Veri(x, 4)
                    .Add , , Veri(x, 5)
                    .Add , , Veri(x, 6)
                    .Add , , Veri(x, 7)
                    .Add , , Veri(x, 8)
                    .Add , , Veri(x, 9)
              
                    .Add , , Say
                End With
            End If
        Next
    End With
    If Say > 0 Then
        Sheets("Giris").Range("A1:I1").AutoFilter Field:=sut, Criteria1:="=*" & TextBox1.Text & "*", Operator:=xlAnd
    ElseIf Say = 0 Then
        listegoster1
        MsgBox "Aranan veri bulunamadı!" & vbLf & vbLf & "Aranan : " & TextBox1, vbExclamation
        TextBox1 = ""
        TextBox1.SetFocus
    End If
Else
    If Sheets("Giris").AutoFilterMode Then Sheets("Giris").AutoFilterMode = False
    listegoster1
End If

Application.ScreenUpdating = 1
Merhaba iyi geceler.
Bu kodu listbox için uyarlayabilirmiyiz acaba
 

Cengizhantr06

Altın Üye
Katılım
16 Mayıs 2020
Mesajlar
301
Excel Vers. ve Dili
Office 365 Türkçe
Altın Üyelik Bitiş Tarihi
18-05-2025
örnek dosya ekledim
 

Ekli dosyalar

Üst