搜索匹配的文本字符串并更改字体颜色答案

【问题标题】：Search text string for a match and change font color搜索匹配的文本字符串并更改字体颜色
【发布时间】：2013-08-02 17:37:10
【问题描述】：

我使用 Excel 已经 6 年了，我有点生疏了。这是我的场景：

我正在将问题列表导出到 Excel。我需要能够将单元格（多个值）中的关联链接号彼此区分开来。例如，我有两列，

Key = 票号

关联的问题 = 关联的键

我需要一个语句来扫描 Key 列并在 Linked Issues 列中找到匹配项。然后，一旦找到匹配项，匹配的文本将采用 Key 的字体颜色。

复杂的地方在于，Linked Issues 列的每个单元格都可能类似于 iss-3913、iss-3923、iss-1649。所以本质上，扫描将是字符串中的匹配项。任何帮助表示赞赏。

【问题讨论】：

您是否希望在一个单元格中包含多种字体颜色？另外，请告诉我：例如，第一列是否有“iss-3913”，第二列是否有“3923、1649、8352”？还是第二列也有“iss-3923,iss-1649,iss-8352”？
因此单元格“A1”包含单个值 iss-3715，颜色为红色（A 列中的所有值都是唯一的）。 Z列中的多个单元格在链接问题的字符串中包含iss-3715，例如。 ISS-2190、ISS-2222、ISS-3715、ISS-9000 在一个单元格中。我希望能够有匹配的字符串片段来继承它在 A 列中匹配的字体颜色。

标签： string vba excel excel-formula excel-2010

【解决方案1】：

~~很抱歉，我现在没有时间完成这个，但是~~这样的事情会帮助~~第一列中的每个单元格可能有一个循环~~?

编辑：现在已完成，第二次编辑更新到 B5 和 Z5，编辑 3 个固定的错误与列引用并更新为使用变量来分配要查看的列。

Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
    o = start_row 'start with row one for second column
    Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
    If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then  'if cell contents found in cell
        With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
            .Color = Cells(i, key_col).Font.Color  'change color of this part of the cell
        End With
    End If
    o = o + 1 'increment the cell in second column
    Loop
    i = i + 1 'increment the cell in the first column
Loop
End Sub

或许

这样的？

Excel VBA: change font color for specific char in a cell range

【讨论】：

太棒了。这正是我想要的！如果我的键 (row1/cell1) 从第 2 行/cell5 (B5) 开始，并且我的链接问题在第 26 行 (Z$) 中，我应该操作哪些字段？
@user2642587 我更新了代码。 i 是开始的“关键”行。 o 是起始的“链接问题”行。随处可见 Cells(i,2) 这两个代表“键”的列。随处可见 Cells(o,26) 26 代表“链接问题”的列。祝你好运。
实际上这不会改变第 26 列中的任何内容。
好的，只要我在 A 列中的键有效，但导出在该字段中命名项目。让我做一些改变。
@user2642587 好的，对上次更新感到抱歉，我在转换列时发现了一个问题，所以我将它们设为变量，您现在可以更改起始行和列。如果您没有注意到，请稍加注意，如果您的数据之间有一个空单元格，这些循环将停止。我以为没有。祝你好运。

【解决方案2】：

这是一篇旧帖子，但我想我可以解决我遇到的条件格式问题。

Sub colorkey()
start_row = 5
key_col = 2
flag_col = 4

i = start_row 'start on row one

  Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell

  Tval = Cells(i, flag_col).Value
    Select Case Tval
    Case "Requirement"
        'cval = green
        cVal = 10
    Case "New Feature"
        'cval = orange
        cVal = 46
    Case "Test"
        'cval = lt blue
        cVal = 28
    Case "Epic"
        'cval = maroon
        cVal = 30
    Case "Story"
        'cval = dk blue
        cVal = 49
    Case "Theme"
        'cval = grey
        cVal = 48
    Case "Bug"
        'cval = red
        cVal = 3
    Case "NOT MAPPED"
        'cval = Maroon
        cVal = 1
    End Select


Cells(i, key_col).Font.ColorIndex = cVal

    i = i + 1 'increment the cell in the first column
    Loop

End Sub
Sub colorlinked()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
    o = start_row 'start with row one for second column
    Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
    If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then  'if cell contents found in cell
        With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
            .Color = Cells(i, key_col).Font.Color  'change color of this part of the cell
        End With
    End If
    o = o + 1 'increment the cell in second column
    Loop
    i = i + 1 'increment the cell in the first column
Loop
MsgBox "Finished Scanning"
End Sub

【讨论】：