[英]Change actual font color based on another cell value in the Row
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. 我目前有一个工作表,它调查B列并将Z列中的字符串与String匹配,然后将匹配的String的颜色更改为B列中的font.color。问题是B列通过条件格式着色,因此代码无法识别。 I need to be able to have the actual font color change in column B when the condtion is true.
当条件为真时,我需要能够在B列中具有实际的字体颜色更改。 In addition, the code would need to be incremented until the last row of the sheet is reach.
另外,将需要增加代码,直到到达工作表的最后一行。
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
块引用
Just in case you simply want "the solution you tried before" to work, here is how you get the conditional formatting working: 万一您只是希望“您尝试过的解决方案”起作用,这是使条件格式起作用的方式:
=ISNUMBER(SEARCH(B1, "EPIC"))
=ISNUMBER(SEARCH(B1, "EPIC"))
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! 这似乎是您所要的...如果不是,请在评论中进行说明!
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 FormatCondition
variable and apply to the cell later if you wish. 您甚至可以将其存储在
FormatCondition
变量中,然后根据需要应用于单元格。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.