【マクロ】文字検索をして色を付ける

 

Sub kensaku()

Dim i, cnt As Long, v, F As String, c As Range

Application.ScreenUpdating = False

v = Application.InputBox("検索値は？", "値検索", Selection)

If v = "False" Or v = "" Then MsgBox "キャンセル", 64: End

Set c = Cells.Find(v, , xlValues, xlPart)

If Not c Is Nothing Then

F = c.Address

Do

c.Interior.PatternColorIndex = 6

c.Interior.Pattern = 9

c.Font.Color = 255

Set c = Cells.FindNext(c)

If c.Address = F Then Exit Do

Loop

End If

Application.ScreenUpdating = True

Application.OnKey "{f3}", "FontC"

Application.OnKey "^x"

End Sub

Sub FontC()

Application.ScreenUpdating = False

  Cells.Select

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    With Selection.Font

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

         Range("A1").Select

        

    End With

Application.ScreenUpdating = True

End Sub