把单元格内前后都出现的字体标红

yshcy

如图，A2中的两个中国要标红，A4中的两个山东字体要标红。现在是整个单元格的字体全红了。请指教。

yu3924

你正则表达式写的是匹配2个及以上的所有中文字符 当然全红了

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
   
Sub test()
    Dim reg, arr(), i, j, k, 起点, 长度
    Set reg = CreateObject("vbscript.regexp")
    arr = Range("a1").CurrentRegion
    For i = 2 To UBound(arr)
        Cells(i, 1).Font.Color = 1
        With reg
            .Global = True
            .Pattern = "([一-龢]{2,}).+\1"
            Set j = .Execute(arr(i, 1))
            If j.Count > 0 Then
                s = j(0).submatches(0)
                x = InStr(arr(i, 1), s)
                Cells(i, 1).Characters(x, Len(s)).Font.Color = 255
                x = InStrRev(arr(i, 1), s)
                Cells(i, 1).Characters(x, Len(s)).Font.Color = 255
            End If
        End With
    Next i
End Sub

yshcy

quqiyuan 发表于 2024-11-30 13:35
参与一下，仅供参考。。。

如果A2单元格里，有三个 中国  呢？或者相同的字符不在本单元格的末尾呢？

xlj310

yshcy 发表于 2024-11-30 14:07
如果A2单元格里，有三个 中国  呢？或者相同的字符不在本单元格的末尾呢？

有多个的话，自己把下面的匹配改成 再遍历一次字符串即可。

yshcy

xlj310 发表于 2024-11-30 14:46
有多个的话，自己把下面的匹配改成 再遍历一次字符串即可。

我是想，如您图片里的A2单元格，那所有的广东都要标上红色。请指教，谢谢

yshcy

xlj310 发表于 2024-11-30 14:46
有多个的话，自己把下面的匹配改成 再遍历一次字符串即可。

Sub test()
Dim reg, arr(), i, j, k
Set reg = CreateObject("vbscript.regexp")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
    Cells(i, 1).Font.Color = 1
With reg
    .Global = True
    .Pattern = "([一-龢]{2,}).+\1"
    Set j = .Execute(arr(i, 1))
    If j.Count > 0 Then
        s = j(0).submatches(0)
       For k = 1 To Len(Cells(i, 1)) - Len(s) + 1
        If Mid(Cells(i, 1), k, Len(s)) = s Then Cells(i, 1).Characters(k, Len(s)).Font.Color = vbRed
       Next k
    End If
End With
Next i
End Sub

xlj310

yshcy 发表于 2024-11-30 15:09
我是想，如您图片里的A2单元格，那所有的广东都要标上红色。请指教，谢谢

我特意改了正则表达式的。
你想把广东都标上红色，说明 你匹配的文字只有两个字，你只用两个字 广东就都可以匹配上了呀