現在、列 B を調べて、文字列を列 Z の文字列と照合し、一致する文字列の色を列 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
引用符