セル内の指定文字に色をつける関数

'***************************************
'* セル内の指定文字に色をつける
'* txt：指定文字
'* colorNum：カラー番号。vbBlue, vbGreen, vbCyan, vbRed, vbYellow など
'* rng：指定文字の入ったセル
Sub ColorText(ByVal txt As String, ByVal colorNum As Long, ByVal rng As Range)
    Dim Text As String
    Dim FindText As String
    Dim TextLength As Long
    Dim FindLength As Long
    Dim i As Long
    Dim j As Long
    
    If rng.Count <> 1 Then
        MsgBox "処理するセルは、1個限定です。マクロ終了します"
        Exit Sub
    End If
    
    Text = rng.Value
    FindText = txt
    TextLength = Len(Text)
    FindLength = Len(FindText)
    
    For i = 1 To TextLength - FindLength + 1
        If Mid(Text, i, FindLength) = FindText Then
            For j = i To i + FindLength - 1
                rng.Characters(j, 1).Font.Color = colorNum
            Next j
        End If
    Next i
End Sub

Private Sub ColorTextテスト()
    Call ColorText("業務", vbRed, ActiveCell)
End Sub