• DİKKAT

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

aranan hücrenin renklenmesi

mcetinkaya65

Altın Üye
Katılım
1 Mart 2011
Mesajlar
490
Excel Vers. ve Dili
2021 türkçe
Excell 2007 de 1 excel sayfasında bul özelliğini kullanarak bulunan hücrenin renklenmesi mümkün mü?
teşekkürler..
 
Excell 2007 de 1 excel sayfasında bul özelliğini kullanarak bulunan hücrenin renklenmesi mümkün mü?
teşekkürler..


Merhaba,

Aradığınız sözcüğü renklendirmek olasıdır. Kodları deneyiniz.

Kodlar içinde geçen sözcükleri de arıyor, bire bir eşleşmesini isterseniz
Kod:
        Set c = .Find(Ara, LookIn:=xlValues)
satırına kırmızı ile belirlediğim kısmı da eklemek gerekir.
Kod:
        Set c = .Find(Ara, LookIn:=xlValues[COLOR=red][B], LookAt:=xlWhole[/B][/COLOR])

Dosyadaki kod aşağıdakidir.

Kod:
Sub Bul_ve_Renklendir()
    Dim Sat As Long, _
        Kol As Integer, _
        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
    Kol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    Sat = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Adt = 0
    
    With Range(Cells(1, "A"), Cells(Sat, Kol))
        Set c = .Find(Ara, LookIn:=xlValues)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
            Adt = Adt + 1
                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
 

Ekli dosyalar

harika bir uygulama çok teşekkür ederim çok işime yarayacak yaptım güzel oldu fakat bulunan ve renklenen hücrelerin üzerine gitmesi mümkün mü acaba???
 
Sevgili Necdet Hocam güzel bir çalışma olmuş. Çok teşekkürler
 
Geri
Üst