这是基本原则，我假设定制这个代码不是你所要求的（因为没有提供关于这方面的细节）：

Sub Colors()

 With Range("A1")
    .Value = "Test"
    .Characters(2, 2).Font.Color = vbGreen
 End With

 End Sub

小描述，虽然它说明了自己：第一个“2”表示需要着色的第一个字符，第二个“2”表示长度。

这只是为了将来的读者试图突出显示单元格内的特定字符串模式，
（这就是我对这个问题的解释）在本例中，您可以在F1中设置要搜索的字符串

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub

这是专门针对@t.ztrk的答案，他在第1列中有城市，并在第2列中有用于搜索这些城市的文本。他在这里发布了他的问题：is it possible to find and change color of the text in excel
我从另一个解决方案中借用了这段代码（如果不是原始代码，请见谅）：https://stackoverflow.com/a/11676031/8716187

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub

我知道这可能不优雅，但我打了几分钟，以满足用户的需要。如果上面提供的解决方案（1）更灵活或（2）更有效，请提前表示歉意。也为我的C++嵌套循环习惯的养成表示歉意。
@t.ztrk你可以录制一个宏，然后停止它（删除那里的任何内容），或者插入一个按钮控件并将代码粘贴到那里。不确定你对VB的熟悉程度。只要确保在运行宏之前选择了工作表上你想处理的单元格（它应该在任何工作表上运行，并且可以在任何工作簿上工作）。

Sub Macro1()
'Searches all text in Column 2 on a Sheet for the string located in Column 1
'If found it highlights that text
Dim ThisWB As Workbook
Dim ThisWS As Worksheet
Dim i As Integer
Dim y As Integer

Dim Col1 As Double
Dim Col2 As Double

Dim Col1_rowSTART As Double
Dim Col1_rowEND As Double

Dim Col2_rowSTART As Double
Dim Col2_rowEND As Double

Dim strTest As String
Dim strLen As Integer

'Set up parameter that we know
Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 1 'city column
Col2 = 2 'text search column
'Define Starting Row for each column
Col1_rowSTART = 1
Col2_rowSTART = 1
'Define ending row for each column
Col1_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col1).End(xlUp).Row
Col2_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col2).End(xlUp).Row

'Could be fancy and see which column is shorter ....
'Won't do that here

For i = Col1_rowSTART To Col1_rowEND
    'make a string out of each cell value in Col1
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)
    'Roll thorugh all of Column 2 in search of the target string
    For y = Col2_rowSTART To Col2_rowEND
        'Check if Col1 string is in Col2 String
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
        End If
    Next y
Next i

MsgBox ("City Search Complete!")

End Sub

这是您的测试屏幕截图。x1c 0d1x
干杯-继续学习和应用。-WWC

在单元格中高亮显示文本的一个问题是，该字符串可能不止一次出现，因此代码应该检查是否还有其他字符串。

Sub Colors()

    Dim searchTerms As Variant

    searchTerms = Array("searchterm1", "searchterm2",  "lastsearchterm")

    Dim searchString As String
    Dim targetString As String
    Dim offSet As Integer
    Dim colToSearch As Integer
    Dim arrayPos, rowNum As Integer

    colToSearch = 3

    For arrayPos = LBound(searchTerms) To UBound(searchTerms)
        For rowNum = 2 To 31124

            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colToSearch).Value

            x = HilightString(offSet, searchString, rowNum, colToSearc)

        Next rowNum
    Next arrayPos

 End Sub

Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer

            Dim x As Integer
            Dim newOffset As Integer
            Dim targetString As String

            ' offet starts at 1

            targetString = Mid(Cells(rowNum, ingredCol), offSet)

            foundPos = InStr(LCase(targetString), searchString)

            If foundPos > 0 Then

                ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
                Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbRed

                ' increment the offset to found position + 1 + the length of the search string
                newOffset = offSet + foundPos + Len(searchString)

                x = HilightString(newOffset, searchString, rowNum, ingredCol)
            Else
                ' if it's not found, come back out of the recursive call stack
                Exit Function
            End If
End Function

@Jack BeNimble谢谢你的代码，用它在10分钟内成功地高亮显示了一个单元格中的所有数字。我稍微重新组织了一下，首先搜索一行和一个单元格中的所有搜索词，并允许多列。我发现了一个错误，你的高亮文本不喜欢重复55，444，只高亮显示了一个序列中的奇数重复。修改了高亮功能中的一行

newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.

这是我修改过的代码。
子编号颜色（）

Dim searchTerms As Variant

searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")

Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer

colsToSearch = Array(4, 44, 45)

For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
    colNum = colsToSearch(colIndex)
    For rowNum = 5 To 3000
        For arrayPos = LBound(searchTerms) To UBound(searchTerms)
            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colNum).Value

            x = HilightString(offSet, searchString, rowNum, colNum)
        Next arrayPos
    Next rowNum
Next colIndex

末端子组件
函数HightString（偏移量为整数，搜索字符串为字符串，行数为整数，ingredCol为整数）为整数

Dim x As Integer
        Dim newOffset As Integer
        Dim targetString As String

        ' offet starts at 1

        targetString = Mid(Cells(rowNum, ingredCol), offSet)

        foundPos = InStr(LCase(targetString), searchString)

        If foundPos > 0 Then

            ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue

            ' increment the offset to found position + 1 + the length of the search string
            newOffset = offSet + foundPos + Len(searchString) - 1

            x = HilightString(newOffset, searchString, rowNum, ingredCol)
        Else
            ' if it's not found, come back out of the recursive call stack
            Exit Function
        End If

结束功能
谢谢Jack Bennble和数据库

功能性方法

为了扩展已经给出的答案，将其放入一个函数中会更有帮助，这样它对任何文本都更灵活。
在我的方法中，我还想控制要突出显示的文本示例，所以我提供了一个instance参数，它可以是：

• 0用于突出显示所有匹配项
• 从左边看是正数
• 或者从右边看是负数

此外，我认为在应用新的字体颜色之前，为用户提供一个将字体重置为xlAutomatic的选项可能会有所帮助。

' This highlights certain text within a cell
' The instance can be 0 for all, specific index
' or even use negative indexing to search from
' the right side of the string.
' @author <robert@roberttodar.com>
Sub HighLightCellText( _
    target As Range, _
    text As String, _
    Optional instance As Long, _
    Optional color As Long = vbRed, _
    Optional resetCellBeforeHighlight As Boolean = False _
)
    ' Just in case the user wants a cell with no font
    ' coloring beforehand
    If resetCellBeforeHighlight Then
        target.Font.ColorIndex = xlAutomatic
    End If
    
    ' Get all the starting indexs of the text
    Dim indexes As Collection
    Set indexes = GetStartingIndexes(target.Value2, text)
    
    ' This allows the user to provide a negative index,
    ' meaning they can search from the right side of the
    ' text
    If instance < 0 Then
        instance = instance + (indexes.count + 1)
    End If
    
    Dim index As Long
    For index = 1 To indexes.count
        If index = instance Or instance = 0 Then
            ' This is the method for changing specific
            ' font of a cell.
            target.Characters( _
                start:=indexes.Item(index), _
                length:=Len(text) _
            ).Font.color = color
        End If
    Next
End Sub

上面的这个函数使用另一个helper函数来查找找到的文本的每个示例的所有起始索引。

' Helper function to get all the starting indexes of
' a specific text. This expands the `Instr` method
Public Function GetStartingIndexes( _
    ByVal text As String, _
    ByVal textToFind As String _
) As Collection
    Set GetStartingIndexes = New Collection
    
    Dim start As Long
    start = 1
    
    Do Until InStr(start, text, textToFind) = 0
        ' Find current iteration and add to collection
        start = InStr(start, text, textToFind)
        GetStartingIndexes.Add start

        ' Increment the start to after the last iteration
        start = start + Len(textToFind)
    Loop
End Function

您不需要VBA来执行此操作。您可以使用条件格式。
假设E列中有一组值。您要在单元格B1中输入一个值，并突出显示E列中与该值匹配的单元格。
突出显示E列中的单元格，并应用以下条件格式：

更改颜色以适应。这将对E列中的单元格应用相对条件格式。例如：选择E3并查看条件格式，它应如下所示：

你可以看到公式是如何自我调整的。
（**编辑：**如果要将B1中的值与E列中某个值的子字符串进行匹配，请改用以下条件格式公式：x1月1x）
现在在单元格B1中键入不同的值。如果键入的值与E列中的某个值匹配，则E列中的这些单元格将更改颜色。将单元格B1更改为E列中不存在的值，格式将消失。