test批量关键词高亮bug？？？【爱疯答案】

youxianwei

test批量关键词高亮bug？？？【爱疯答案】

youxianwei

Sub test()

Dim str, reg, match, matchs, x
Set reg = CreateObject("VBScript.RegExp")
reg.Global = True
紫色关键词 = Array("/", "主梁", "次梁", "网架", "悬索", "筒壳", "框架", "剪力", "装配整体式", "连梁", "钢筋混凝土梁", "全熔透焊缝连接", "摩擦型高强螺栓连接", "全焊接连接")
For i = 0 To UBound(紫色关键词)
    str = 紫色关键词(i)
    For Each x In ActiveSheet.UsedRange
        If InStr(x, str) Then '''''''''''''''''''''''''''''''''''''''''''''''''错误13类型不匹配??????
        On Error Resume Next
            x.Font.ColorIndex = xlAutomatic
            reg.Pattern = str
            Set matchs = reg.Execute(x)
            For Each match In matchs
                x.Characters(Start:=match.firstindex + 1, Length:=match.Length).Font.ColorIndex = 3
            Next
        End If
    Next
Next

End Sub

爱疯

Dim arr, keys, reg
Sub test()
    Dim i, j
    Range("a:d").Font.ColorIndex = xlAutomatic
    arr = Range("a1").CurrentRegion
    keys = Range("f1").CurrentRegion
    Set reg = CreateObject("VBScript.RegExp")

    For i = 1 To UBound(arr)
        For j = 2 To UBound(arr, 2) Step 2    '只处理 B列、D列
            If TypeName(arr(i, j)) <> "Error" Then Call highLight(i, j)
        Next j
    Next i
End Sub

'高亮字色
Sub highLight(r, c)
    Dim match, matchs, i
    For i = 1 To UBound(keys)
        If InStr(arr(r, c), keys(i, 1)) Then
            reg.Pattern = keys(i, 1)
            Set matchs = reg.Execute(arr(r, c))
            For Each match In matchs
                Cells(r, c).Characters(Start:=match.firstindex + 1, Length:=match.Length).Font.ColorIndex = 3
            Next
        End If
    Next
End Sub
批量关键词2.rar (69.33 KB, 下载次数: 39)

2016-11-1 15:56 上传

点击文件名下载附件



为方便查看和修改，写成两个过程。
关键词在F列。

youxianwei

非常感谢！

youxianwei

爱疯 发表于 2016-11-1 15:56
Dim arr, keys, reg
Sub test()
    Dim i, j

非常感谢！

youxianwei

爱疯 发表于 2016-11-1 15:56
Dim arr, keys, reg
Sub test()
    Dim i, j

大神，又有bug了，新的答案又只能高亮单元格中第1次关键词了，不能高亮第234次出现的关键词，经研究漏了正则表达式漏了global=true属性