vba 根据行中的另一个单元格值更改实际字体颜色

Change actual font color based on another cell value in the Row

提问by user2642587

I currently have a worksheet that looks into column B and matches the string with a String in Column Z then changes the color of the matching String to font.color in column B. The problem is that column B is colored by conditional formatting so the code is unrecognized. I need to be able to have the actual font color change in column B when the condtion is true. In addition, the code would need to be incremented until the last row of the sheet is reach.

我目前有一个工作表，它查看 B 列并将字符串与 Z 列中的字符串匹配，然后将匹配字符串的颜色更改为 B 列中的 font.color。问题是 B 列通过条件格式着色，因此代码无法识别。当条件为真时，我需要能够在 B 列中更改实际的字体颜色。此外，代码需要递增，直到到达工作表的最后一行。

Here's the current conditional formats I have setup

这是我设置的当前条件格式

Blockquote

块引用

=ISNUMBER(SEARCH("Story",Template!D5))=TRUE 'format dark blue
=ISNUMBER(SEARCH("Requirement",Template!D5))=TRUE 'format green
=ISNUMBER(SEARCH("EPIC",Template!D5))=TRUE 'format red
=ISNUMBER(SEARCH("Test",Template!D5))=TRUE 'format teal
=ISNUMBER(SEARCH("New Feature",Template!D5))=TRUE 'format orange
=ISNUMBER(SEARCH("Theme",Template!D5))=TRUE 'format gray

Blockquote

块引用

Sub Main()
  Call NoLinks
  Call SetCellWarning
  Call colortext
End Sub

Sub NoLinks()
ActiveSheet.Hyperlinks.Delete
End Sub

Sub SetCellWarning()
    Dim iLastRow As Long
    Dim cel As Range, rSetColumn As Range

    iLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row

    Set rSetColumn = Range(Cells(5, 26), Cells(iLastRow, 26)) ' Column "Z"...

    For Each cel In rSetColumn
        If cel.Value = "" Then
            With cel
                cel.Value = "NOT MAPPED"
            End With
        End If
    Next cel

End Sub

***'The colortext runs but does not update unless the font color is manually updated***    
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

Blockquote

块引用

回答by Floris

Just in case you simply want "the solution you tried before" to work, here is how you get the conditional formatting working:

以防万一你只是想让“你之前尝试过的解决方案”起作用，这里是你如何让条件格式工作的：

1. Select the cells (in column B) to which you want to apply the conditional formatting
2. Click on "conditional formatting" button. Clear any rules you no longer want, then create a "new rule" based on "an equation being true"
3. Enter the following equation: =ISNUMBER(SEARCH(B1, "EPIC"))
4. Select the format you want for cells with the text "EPIC" in them (note - with this order of "SEARCH", we look for the text in B1 to be contained in the phrase "EPIC", so "E" will match, as will "IC". If you want only cells with "That was EPIC" to be matched, you need to reverse the order of the arguments
5. Add more rules for the other words you want to match, and the color you need

1. 选择要应用条件格式的单元格（在 B 列中）
2. 单击“条件格式”按钮。清除您不再需要的任何规则，然后根据“等式成立”创建一个“新规则”
3. 输入以下等式： =ISNUMBER(SEARCH(B1, "EPIC"))
4. 为其中包含文本“EPIC”的单元格选择所需的格式（注意 - 使用“SEARCH”的顺序，我们在 B1 中查找要包含在短语“EPIC”中的文本，因此“E”将匹配，和“IC”一样。如果您只想匹配带有“That was EPIC”的单元格，则需要颠倒参数的顺序
5. 为您要匹配的其他单词添加更多规则，以及您需要的颜色

This is what the dialog looks like when you have just created a single rule:

当您刚刚创建了一条规则时，对话框是这样的：

And this is what the "conditional formatting" dialog looks like after you have completed the second rule (in my example, I applied these rules to 8 cells):

这就是完成第二条规则后“条件格式”对话框的样子（在我的示例中，我将这些规则应用于 8 个单元格）：

At this point, the spreadsheet looks like this:

此时，电子表格如下所示：

This seems to be what you were asking for... if it's not, then please clarify in the comments!

这似乎是您所要求的……如果不是，请在评论中澄清！

回答by user2642587

Here's the winning solution:

这是获胜的解决方案：

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 = red
    cVal = 3
Case "Story"
    'cval = dk blue
    cVal = 49
Case "Theme"
    'cval = grey
    cVal = 48
Case "NOT MAPPED"
    'cval = Maroon
    cVal = 53
End Select
Cells(i, key_col).Font.ColorIndex = cVal

i = i + 1 'increment the row
Loop

End Sub

回答by varocarbas

Getting rid of the conditional formatting is easy:

摆脱条件格式很容易：

If (Cells(i, key_col).FormatConditions.Count > 0) Then
    Cells(i, key_col).FormatConditions.Delete 
End If
.Color = Cells(i, key_col).Font.Color  'change color of this part of the cell

You can even store it in a FormatConditionvariable and apply to the cell later if you wish.

FormatCondition如果您愿意，您甚至可以将其存储在一个变量中并稍后应用于单元格。