listwiev benzersiz filtreleme hk.

[kemal turan]

merhaba,
Verıtabanı sayfası I sutununda bulunan isimleri benzersiz filtrelemek istiyorum. Countıf ekledim ama olmadı
yardımlarınız için teşekkür ederim.

Private Sub TextBox1_Change()
Set SH = Sheets("VERITABANI")
Application.ScreenUpdating = False
ListView1.ListItems.Clear
ListView1.FullRowSelect = True
Dim i As Long
With ListView1
For i = 2 To SH.Cells(65536, "a").End(xlUp).Row
If UCase(Replace(Replace(SH.Cells(i, "I").Value, "ı", "I"), "i", "İ")) _
    Like "*" & TextBox1.Value & "*" _
    And WorksheetFunction.CountIf(SH.Range("I2:I")) = 1 Then
    
    
   .ListItems.Add , , SH.Cells(i, "I")
        X = X + 1
 
      
        .ListItems(X).ListSubItems.Add , , SH.Cells(i, "J")
        .ListItems(X).ListSubItems.Add , , SH.Cells(i, "K")
        .ListItems(X).ListSubItems.Add , , SH.Cells(i, "G")
        
    End If

Next i
End With
Set SR = Nothing

Application.ScreenUpdating = True

End Sub

 

[kemal turan]

Aşağıdaki şekilde de hata veriyor

If UCase(Replace(Replace(SH.Cells(i, "I").Value, "ı", "I"), "i", "İ")) _
    Like "*" & TextBox1.Value & "*" _
 And WorksheetsFunction.CountIf(SH.Range("I:I"), 1) Then

 

[Hakan ERDOST]

Private Sub TextBox1_Change()
    Dim SH As Worksheet
    Dim i As Long
    Dim X As Long
    Dim uniqueNames As Collection
    Dim name As Variant

    Set SH = Sheets("VERITABANI")
    Set uniqueNames = New Collection

    Application.ScreenUpdating = False
    ListView1.ListItems.Clear
    ListView1.FullRowSelect = True

    ' Sütun I'deki her hücre üzerinde döngü
    For i = 2 To SH.Cells(65536, "I").End(xlUp).Row
        ' Büyük harfe çevir ve Türkçe karakterleri değiştir
        name = UCase(Replace(Replace(SH.Cells(i, "I").Value, "ı", "I"), "i", "İ"))

        ' İsim TextBox1'deki değeri içeriyorsa
        If InStr(name, UCase(TextBox1.Value)) > 0 Then
            ' İsim benzersizse
            On Error Resume Next
            uniqueNames.Add name, CStr(name)
            On Error GoTo 0

            If Err.Number = 0 Then ' İsim benzersiz
                With ListView1
                    ' ListView'e benzersiz ismi ekle
                    X = X + 1
                    .ListItems.Add , , name
                    .ListItems(X).ListSubItems.Add , , SH.Cells(i, "J")
                    .ListItems(X).ListSubItems.Add , , SH.Cells(i, "K")
                    .ListItems(X).ListSubItems.Add , , SH.Cells(i, "G")
                End With
            End If
        End If
    Next i

    Set SH = Nothing
    Set uniqueNames = Nothing
    Application.ScreenUpdating = True
End Sub

Deneyiniz.

 

[kemal turan]

Çok teşekkür ederim.
Selametle kalınız