根据条件设置单元格内部分字符的颜色

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim regEx As Object, aMatch As Object, ar, i&, j&, dic As Object, vKey
   
    Set dic = CreateObject("Scripting.Dictionary")
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Global = True
  
    With Sheets(1)
        With Range(.[N2], .Cells(Rows.Count, "N").End(3))
            ar = .Value
            For i = 1 To UBound(ar)
                If .Cells(i).Font.ColorIndex <> -4105 Then
                    dic(ar(i, 1)) = .Cells(i).Font.ColorIndex
                End If
            Next i
        End With
    End With
    With Range([A1], ActiveSheet.UsedRange)
        With .Columns(3).Font
            .ColorIndex =0: .Bold = False: .Italic = False
        End With
        ar = .Value
        For i = 1 To UBound(ar)
             For Each vKey In dic.keys
                 regEx.Pattern = vKey
                 For Each aMatch In regEx.Execute(ar(i, 3))
                     With .Cells(i, 3).Characters(aMatch.firstIndex + 1, Len(vKey)).Font
                         .ColorIndex = dic(vKey): .Bold = True: .Italic = True
                     End With
                 Next
             Next
        Next i
    End With
End Sub

gwjkkkkk

请参考。。。

sunshuangzhong

半百 发表于 2023-5-16 14:23
试了可以啊。

原来是wps的问题。excel可以！再次感谢！