|
以下是本论坛一大神写的代码,现在我想把颜色调换一下,黑的变红的,红的变黑的,就会失效。
我想要的结果就是相同的字符还是黑色显示,不同的字符标红,最好再加粗一下。
求大神帮忙看下如何调换颜色,非常感谢
以下是代码:
Sub 标注不同字符C()
Dim myrow%, i%, j%, n%, m%, s%
Dim str$, s1$, s2$, s3$
Dim strA$, strB$
On Error Resume Next
Call 恢复颜色
''将区域设置为文本格式
Columns("C").NumberFormatLocal = "@"
myrow = Range("A65536").End(xlUp).Row
For i = 2 To myrow
''先修改全部字符串的颜色
Cells(i, 3).Font.Color = vbRed
Cells(i, 11).Font.Color = vbRed
strA = Cells(i, 3).value
strB = Cells(i, 11).value
''提取最大相同字符串
s1 = xt(strA, strB)
abc:
m = Len(s1)
n = InStr(1, Cells(i, 3).value, s1, 1)
' n = InStr(1, strA, s1, 1)
''.Characters(Start:=1, Length:=1).Font....
Cells(i, 3).Characters(n, m).Font.ColorIndex = vbBlack '改成黑色
'下面三行代码不要了,只在C列上色
' n = InStr(1, Cells(i, 11).value, s1, 1)
' n = InStr(1, strB, s1, 1)
' Cells(i, 11).Characters(n, m).Font.ColorIndex = vbBlack '改成黑色
''去除相同内容后,再提取相同内容
strA = Replace(strA, s1, "", 1, , 1)
strB = Replace(strB, s1, "", 1, , 1)
If StrReverse(strA) <> strB Then
If Len(strA) >= 2 And Len(strB) >= 2 Then
''提取最大相同字符串
s1 = xt(strA, strB)
If s1 <> "" Then
GoTo abc
End If
End If
End If
m = 0
n = 0
Next i
End Sub
|
|