用VBA
Sub FM()
Dim rC, rT As Range
Dim i, j As Integer, k As String
Set rT = Sheets("Sheet1").Range("D1:D10")
For Each rC In rT
If rC = "" Then Exit For
k = Cells(rC.Row, 2)
If k <> "" Then
For i = 1 To Len(rC)
If InStr(k, Mid(rC, i, 1)) > 0 Then
rC.Characters(i).Font.ColorIndex = 3
Else
rC.Characters(i).Font.ColorIndex = -4105
End If
Next
End If
Next
End Sub
Dim rC, rT As Range
Dim i, j As Integer, k As String
Set rT = Sheets("Sheet1").Range("D1:D10")
For Each rC In rT
If rC = "" Then Exit For
k = Cells(rC.Row, 2)
If k <> "" Then
For i = 1 To Len(rC)
If InStr(k, Mid(rC, i, 1)) > 0 Then
rC.Characters(i).Font.ColorIndex = 3
Else
rC.Characters(i).Font.ColorIndex = -4105
End If
Next
End If
Next
End Sub
代码在D列范围内的单元格为空时会结束，请自行设定适用区域rT的值
更改作为参考标记的B列的值后，请重新运行代码，D列中原本标记为红色的字符，如果B列变化了，在代码运行后会恢复系统默认颜色
温馨提示：答案为网友推荐，仅供参考
第1个回答 2014-08-27
代码如下(附件中有样本文件)：
Sub 字符填色()For i = 1 To [b65536].End(3).Row
If IsEmpty(Cells(i, 2)) Or Len(Cells(i, 4)) = 0 Then GoTo gg
For j = 1 To Len(Cells(i, 4))
If Cells(i, 2) Like "*" & Mid(Cells(i, 4), j, 1) & "*" Then
Cells(i, 4).Characters(Start:=j, Length:=1).Font.ColorIndex = 3
End If
Next
gg:
Next
End Sub
