Ara_Bul_Renklendir

[mcetinkaya65]

Zekasına sağlık,
Form da gezinirken N. YEŞERTENER imzası ile bir çalışma buldum.Kendi hazırladığım proğrama adepte ettim.Fakat
1,Sayfanın tamamında değilde sadece B stununda araması (B3 den başlayıp..)
2,Bulup renklendirdiği kelimeyi o an ki ekrana getirmesi.
3,Sayfaya verdiğimiz rengi silmeden yapması.
mümkünmü?
Saygılarımla.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki şekilde denermisiniz.

Sub Bul_ve_Renklendir()
    Dim c   As Range, _
        Ara As String, _
        Adr As String, _
        Adt As Integer
    
    Ara = InputBox("Aradığınız Sözcüğü Giriniz", "Sözcük Girişi")
    If Ara = "" Then Exit Sub
    
    Application.ScreenUpdating = False

    Cells.Interior.ColorIndex = xlNone
    Adt = 0
    
    With Range("B3:B" & Rows.Count)
        Set c = .Find(Ara, LookIn:=xlValues)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
            Adt = Adt + 1
                c.Activate
                c.Interior.ColorIndex = 3
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Application.ScreenUpdating = True
 
    If Adt > 0 Then
        MsgBox Ara & " Sözcüğü " & Adt & " Kere Bulundu ve Renklendirildi", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    Else
        MsgBox "Aradığınız " & Ara & " Sözcüğü Bulunamadı...", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    End If
End Sub

 

[mcetinkaya65]

İlginize teşekkürler.
Selamlar