Изменить фактический цвет шрифта на основе другого значения ячейки в строке

Question

В настоящее время у меня есть рабочий лист, который смотрит в столбец B и соответствует строке со строкой в ​​столбце Z, а затем меняет цвет соответствующей строки на font.color в столбце B . Проблема состоит в том, что столбец B окрашен условным форматированием, поэтому код не распознается. Мне нужно иметь фактическое изменение цвета шрифта в столбце B, когда условие является истинным. Кроме того, код должен увеличиваться до тех пор, пока не будет достигнут последний ряд листа.

Вот текущие условные форматы У меня есть установка

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

Answer 1

Избавление от условного форматирования легко:

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 и применить к ячейке позже, если вы хотите.

Answer 2

Только в случае, если вы просто хотите «решение, которое вы пробовали раньше» работать, вот как вы получите условную работу форматирования:

1. Выберите ячейки (в колонке B), к которому вы хотите применить условное форматирование
2. Нажмите кнопку «условное форматирование». Удалите все правила, которые вы больше не хотите, а затем создать «новое правило» на основе «уравнение является истинным»
3. Введите следующее уравнение: =ISNUMBER(SEARCH(B1, "EPIC"))
4. Выберите формат, который вы хотите для ячеек с текстом «EPIC» в них (обратите внимание - с этим порядком «ПОИСК» мы ищем текст в B1, содержащийся во фразе «EPIC», поэтому «E» будет соответствовать, как и «IC». Если вы хотите, чтобы только ячейки с «That was EPIC»быть согласованы, необходимо изменить порядок аргументов
5. Добавить дополнительные правила для других слов, которые вы хотите, чтобы соответствовать, и цвет вам

Это то, что диалог выглядит когда вы только что создали одно правило:

И это то, что диалоговое окно «Условное форматирование» выглядит как после того, как вы завершили второе правило (в моем примере, я применял эти правила 8 ячеек) :

На данный момент, таблица выглядит следующим образом:

Это, кажется, то, о чем вы просили ...если это не так, пожалуйста, уточните в комментариях!

Answer 3

Вот выигрышное решение:

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