bul yaparken dolgu rengi olsun

Katılım
25 Ekim 2004
Mesajlar
68
arkadaşlar merhaba...

bul (find) yaparken istediğimiz kelimeyi bulduğunda ilgili hücre rengini belirlediğimiz bir dolgu rengi ile göstersin. sizcede hoş olmazmı....:shock:
 
G

Guest

Misafir
Merhaba
Excel dosyasında Ctrl F tuşlarına bastığınızda arama penceresi karşınıza çıkacak bu pencerenin diğer sayfası olan değiştir sayfasını seçiniz.Sonra arama yapacağınız veriyi aranan bölümüne yazın fakat alt taraftaki kutucuğa birşey yazmayın sağ tarafındaki biçim butonunu seçin ekrana açılan uzantıda tekrar biçim seçeneğini seçin.Böylece ekrana biçimlendirme penceresi çıkacak buradan aradığınız hücreyi bulduğunuzda bu hücrelerin formatını nasıl değiştirmek istediğinizi belirleyin ister renklendirin isterk kalın italik yapın istersenizde kenar çizgilerini ekleyiniz hücrenin bütün formatını değiştirebiliryorsunuz.

Umarım işinize yarar.
 
X

xlsx

Misafir
Ben de bu özelligi ilk buldugumda çok işime yaramıştı.Ayrıca buldugumuz verilere arka font ekleyerek sadece o fonttaki verileri Copy yapıp bir yere aktarabiliyoruz
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,324
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Office2000 de böyle bir özellik olmadığı için, daha önce başka bir soru için hazırladığım cevabı bu soru için revize ederek VBA ile bir çözüm;

Kod:
Sub FindExactMatch()
    Dim MyStr As String, InfoMsg As String
    Dim Rng1 As String, LookupValue As String
    Dim MyQ As VbMsgBoxResult
    Dim FoundRng As Variant
    MyStr = Trim(Application.InputBox("Aranacak metni girin !", "Arama..."))
        If Not MyStr = "False" Then
            Set FoundRng = Cells.Find(MyStr, LookIn:=xlValues, LookAt:=xlPart)
            If Not FoundRng Is Nothing Then
                Rng1 = FoundRng.Address
                FoundRng.Select
ResumeSub2:
                If Right(FoundRng.Value, 1) <> " " Then LookupValue = FoundRng.Value & " "
                MyData = Split(LookupValue, " ", , vbTextCompare)
                    For i = LBound(MyData) To UBound(MyData)
                        If MyData(i) = MyStr Then
                            InfoMsg = "Aranan metin " & FoundRng.Address(False, False) _
                            & " hücresinde bulundu." _
                            & vbCrLf & vbCrLf & "Bulunan hücrenin içeriği :" _
                            & vbCrLf & vbCrLf & FoundRng.Value & vbCrLf _
                            & vbCrLf & "Aramaya devam etmek istiyormusunuz ?"
                            ActiveCell.Interior.ColorIndex = 6
                            MyQ = MsgBox(InfoMsg, vbInformation + vbYesNo, "Arama sonucu...")
                            If MyQ = vbYes Then GoTo ResumeSub1:
                            Exit Sub
                        End If
                    Next
            Else
            MsgBox "Aranan değer bulunamadı !", vbInformation, "Arama sonucu..."
            Exit Sub
        End If
ResumeSub1:
    Set FoundRng = Cells.FindNext(FoundRng)
        If Rng1 = FoundRng.Address Then
            MsgBox "Aranan değerden başka bulunamadı !", vbInformation, "Arama sonucu..."
            Exit Sub
        End If
    FoundRng.Select
    GoTo ResumeSub2:
    End If
    Set FoundRng = Nothing
End Sub
 
X

xlsx

Misafir
oziyilmaz arkadasın istedigi olayı eğer pratik olması acısından kullanmak istersek ben dosyada A Sütun ile 1 satırı arasındaki dosya seç alanına basıp ya da CTRL A yapıp sonra CTRL F ile arama yapıyorum.Buldugu veriyi zaten beyaz arka fon olarak gösteriyor.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,324
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Bulunan tüm hücreler değil de, sadece en son bulunan hücreyi renklendirmek için;

Kod:
Sub Test()
    ActiveSheet.UsedRange.Select
    Application.CommandBars.FindControl(ID:=1849).Execute
    ActiveCell.Interior.ColorIndex = 6
    ActiveCell.Select
End Sub
Veya;

Kod:
Sub Test2()
    ActiveSheet.UsedRange.Select
    Application.Dialogs(xlDialogFormulaFind).Show
    ActiveCell.Interior.ColorIndex = 6
    ActiveCell.Select
End Sub
Umarım yukarıdakiler Office97 ile çalışır. Bende olmadığı için deneme şansım olmadı.
 
Üst