引言:本文整理自vbaexpress.com论坛,有兴趣的朋友可以研阅。
Q:我在列D的单元格中存放着一些数据,每个单元格中的多个数据使用换行分开,列E是对列D中数据的相应描述,我需要在列E的单元格中查找是否存在列D中的数据,并将找到的数据标上颜色,如下图1所示。
图1
如何使用VBA代码实现?
A:实现上图1中所示效果的VBA代码如下:
Sub ColorText()
Dim ws As Worksheet
Dim rDiseases As Range
Dim rCell As Range
Dim avDiseases As Variant
Dim iDisease As Long
Dim iMatchStart As Long
Dim iColor As Long
Set ws = Worksheets("Task")
Set rDiseases = Range(ws.Cells(2, 4),ws.Cells(ws.Rows.Count, 4).End(xlUp))
For Each rCell In rDiseases.Cells
iColor = vbRed
avDiseases = Split(rCell.Value, vbLf)
For iDisease = LBound(avDiseases) To UBound(avDiseases)
iMatchStart = 1
Do While iMatchStart > 0
iMatchStart =InStr(iMatchStart, rCell.Offset(0, 1).Value, avDiseases(iDisease),vbTextCompare)
If iMatchStart > 0 Then
rCell.Offset(0,1).Characters(iMatchStart, Len(avDiseases(iDisease))).Font.Color = iColor
iColor = IIf(iColor =vbRed, vbGreen, vbRed)
iMatchStart = iMatchStart Len(avDiseases(iDisease))
End If
Loop
Next iDisease
Next rCell
End Sub
代码中使用Split函数以回车符来拆分单元格中的数据并存放到数组中,然后遍历该数组,在列E对应的单元格中使用InStr函数来查找是否出现了该数组中的值,如果出现则对该值添加颜色。
Bug:通常是交替添加红色和绿色,但是当句子中存在多个匹配或者局部匹配时,颜色会打乱。