Find Komutu ile bulunan mükerrer satırı engellemek

[Ergün Güler]

Selam,
Arkadaşlar, find komutu ile bir değeri birçok kolonda arıyorum. Ancak, bulunan değer aynı satırda birden fazla var ise, satırı ListView'e mükerrer yazıyor. Bunu engelemek isityorum. Aynı zamanda Listview'de aranan değerin olduğu item'i maviye boyuyorum. Bu özelliğin de bozulmamasını istiyorum.
Yardımcı olabilirseniz çok sevinirim.

Private Sub CommandButton1_Click()
Dim son As Long
Dim stok As Worksheet
Dim lv As ListView
Dim bulunan As Range, sat As Long, ilkadres As Variant

Set stok = Sheets("stok")
son = stok.Cells(65536, "B").End(3).Row
Set lv = Me.ListView1
lv.ListItems.Clear
If Me.TextBox1 = "" Then
'MsgBox "textbox boş"
lv.ListItems.Clear
Exit Sub
End If
sat = 1
With stok.Range("A2:M65536")

    Set bulunan = .Find(Me.TextBox1.Text, LookIn:=xlValues)
    If Not bulunan Is Nothing Then
        ilkadres = bulunan.Address
      
        Do
                lv.ListItems.Add
                lv.ListItems(sat) = stok.Cells(bulunan.Row, "A")
                lv.ListItems(sat).SubItems(1) = stok.Cells(bulunan.Row, "B")
                lv.ListItems(sat).SubItems(2) = stok.Cells(bulunan.Row, "C")
                lv.ListItems(sat).SubItems(3) = stok.Cells(bulunan.Row, "D")
                lv.ListItems(sat).SubItems(4) = stok.Cells(bulunan.Row, "E")
                lv.ListItems(sat).SubItems(5) = stok.Cells(bulunan.Row, "F")
                lv.ListItems(sat).SubItems(6) = stok.Cells(bulunan.Row, "G")
                lv.ListItems(sat).SubItems(7) = bulunan.Row '
                lv.ListItems(sat).SubItems(8) = bulunan.Column '
                lv.ListItems(sat).ListSubItems(bulunan.Column - 1).ForeColor = vbBlue
            
                sat = sat + 1
            Set bulunan = .FindNext(bulunan)
        Loop While Not bulunan Is Nothing And bulunan.Address <> ilkadres
    End If
End With
MsgBox sat
End Sub

 

[Korhan Ayhan]

Selamlar,

Ergün bey formunuz üzerinde listelenen sütun sayısı ile sayfadaki sütun sayınız eşleşmiyor. Bu sebeple kodunuz hata üretiyor.

 

[Ergün Güler]

Selamlar,

Ergün bey formunuz üzerinde listelenen sütun sayısı ile sayfadaki sütun sayınız eşleşmiyor. Bu sebeple kodunuz hata üretiyor.

Selam,
Hocam haklısınız dosyayı güncelledim. Yardımlarınız için şimdiden çok teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Arama kodunuzu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub CommandButton1_Click()
    Dim son As Long, satir As Integer, x As Byte
    Dim stok As Worksheet
    Dim lv As ListView
    Dim bulunan As Range, sat As Long, ilkadres As String
 
    Set stok = Sheets("stok")
    son = stok.Cells(65536, "B").End(3).Row
    Set lv = Me.ListView1
    lv.ListItems.Clear
    If Me.TextBox1 = "" Then
    'MsgBox "textbox boş"
    Exit Sub
    End If
    sat = 1
    With stok.Range("A2:K65536")
 
        Set bulunan = .Find(Me.TextBox1.Text, LookIn:=xlValues)
        If Not bulunan Is Nothing Then
            ilkadres = bulunan.Address
 
            Do
                If satir <> bulunan.Row Then
                    lv.ListItems.Add
                    lv.ListItems(sat) = stok.Cells(bulunan.Row, "A")
                    lv.ListItems(sat).SubItems(1) = stok.Cells(bulunan.Row, "B")
                    lv.ListItems(sat).SubItems(2) = stok.Cells(bulunan.Row, "C")
                    lv.ListItems(sat).SubItems(3) = stok.Cells(bulunan.Row, "D")
                    lv.ListItems(sat).SubItems(4) = stok.Cells(bulunan.Row, "E")
                    lv.ListItems(sat).SubItems(5) = stok.Cells(bulunan.Row, "F")
                    lv.ListItems(sat).SubItems(6) = stok.Cells(bulunan.Row, "G")
                    lv.ListItems(sat).SubItems(7) = stok.Cells(bulunan.Row, "H")
                    lv.ListItems(sat).SubItems(8) = stok.Cells(bulunan.Row, "I")
                    lv.ListItems(sat).SubItems(9) = stok.Cells(bulunan.Row, "J")
                    lv.ListItems(sat).SubItems(10) = stok.Cells(bulunan.Row, "K")
                    lv.ListItems(sat).SubItems(11) = bulunan.Row '
                    lv.ListItems(sat).SubItems(12) = bulunan.Column '
                    If InStr(1, lv.ListItems(sat), TextBox1.Text, vbTextCompare) > 0 Then lv.ListItems(sat).ForeColor = vbBlue
                        For x = 1 To 10
                            If InStr(1, lv.ListItems(sat).ListSubItems(x), TextBox1.Text, vbTextCompare) > 0 Then
                                lv.ListItems(sat).ListSubItems(x).ForeColor = vbBlue
                            End If
                        Next
                    sat = sat + 1
                    satir = bulunan.Row
                End If
            Set bulunan = .FindNext(bulunan)
            Loop While Not bulunan Is Nothing And bulunan.Address <> ilkadres
        End If
    End With
End Sub

 

[Ergün Güler]

Selamlar,

Arama kodunuzu aşağıdaki şekilde değiştirip denermisiniz.

Selam Hocam çok teşekkür ederim. Tam istediğim gibi mükerrer satırları göstermiyor. Ellerinize sağlık.
Fakat, aradığım deger bulunan satırın birden fazla kolonunda var ise, o kolon mavi olsun istiyorum. ancak ilk bulunan kolonu mavi yapıyor. örneğin "roll" kelimesini aradığımızda bulunan ilk satırın hem 6. hem de 7. kolonunda bu kelime geçiyor. her iki kolon mavi olsun istiyorum. Nasıl yapabiliriz?

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[Ergün Güler]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

Selam,
Hocam Çok teşekkür ederim. Tam istediğim gibi oldu. Harikasınız yine.
Sayenizde InStr komutunu da öğrenmiş oldum.

İyi çalışmalar.