繁体   English   中英

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

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

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

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

块引用

=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

块引用

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

块引用

万一您只是希望“您尝试过的解决方案”起作用,这是使条件格式起作用的方式:

  1. 选择要对其应用条件格式的单元格(在B列中)
  2. 单击“条件格式”按钮。 清除所有不再需要的规则,然后基于“等式为真”创建“新规则”
  3. 输入以下公式: =ISNUMBER(SEARCH(B1, "EPIC"))
  4. 选择其中包含文本“ EPIC”的单元格所需的格式(请注意-以“ SEARCH”的顺序,我们在B1中查找包含在短语“ EPIC”中的文本,因此“ E”将匹配,就像“ IC”一样。如果只希望匹配“ That was EPIC”单元格,则需要颠倒参数的顺序
  5. 为您要匹配的其他单词和所需颜色添加更多规则

创建单个规则后,对话框将如下所示:

在此处输入图片说明

这是完成第二条规则后的“条件格式”对话框的样子(在我的示例中,我将这些规则应用于8个单元格):

在此处输入图片说明

此时,电子表格如下所示:

在此处输入图片说明

这似乎是您所要的...如果不是,请在评论中进行说明!

摆脱条件格式很容易:

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

您甚至可以将其存储在FormatCondition变量中,然后根据需要应用于单元格。

这是制胜法宝:

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM