更改Excel单元格中文本的颜色

Question

我想像条件格式一样在MS Excel中更改单元格中文本的颜色。我在一个单元格中有不同的文字，例如“ WUG-FGT”或“ INZL-DRE”。我想格式化这些单元格（在我的工作表中的所有单元格），一个已定义的文本（如“ WUG-FGT”）显示为红色，另一个文本“ INZL-DRE”为绿色，但该文本位于同一单元格中。使用“标准”条件格式设置时，我只会将背景色着色。

一个类似的问题是：How can I change color of text in a cell of MS Excel?

但是区别是我（实际上）不从事编程工作。这意味着我需要一个更简单或更简单的解决方案来在excel文件中实现此目标。

这可能吗？我知道如何实现，也可以使用VBA解决方案。

Answer 1

此处示例如何实现所需结果：

Sub test()
    Dim cl As Range
    Dim sVar1$, sVar2$, pos%
    sVar1 = "WUG-FGT"
    sVar2 = "INZL-DRE"
    For Each cl In Selection
        If cl.Value2 Like "*" & sVar1 & "*" Then
            pos = InStr(1, cl.Value2, sVar1, vbTextCompare)
            cl.Characters(pos, Len(sVar1)).Font.Color = vbRed
        End If
        If cl.Value2 Like "*" & sVar2 & "*" Then
            pos = InStr(1, cl.Value2, sVar2, vbTextCompare)
            cl.Characters(pos, Len(sVar2)).Font.Color = vbGreen
        End If
    Next cl
End Sub

测试

更新

  

是否可以计算检测到单词的频率。将总金额写入定义的单元格，或者用控制变量在单词后面的括号中加上计数，这又是一件好事吗？因此，在您的示例中：A2：“ WUG-FGT（1）”，A4：“ WUG-FGT（2）”，A5：“ WUG-FGT（3）”

是，但是您应该在着色之前更新单元格，否则整个单元格字体将以第一个字符的颜色进行着色（例如，单元格同时包含关键字，第一个为红色，第二个为绿色，更新后整个单元格字体将为红色）。查看更新的代码并测试以下信息：

Sub test_upd()
    Dim cl As Range, sVar1$, sVar2$, pos%, cnt1%, cnt2%
    Dim bVar1 As Boolean, bVar2 As Boolean

    sVar1 = "WUG-FGT": cnt1 = 0
    sVar2 = "INZL-DRE": cnt2 = 0

    For Each cl In Selection
        'string value should be updated before colorize
        If cl.Value2 Like "*" & sVar1 & "*" Then
            bVar1 = True
            cnt1 = cnt1 + 1
            cl.Value2 = Replace(cl.Value, sVar1, sVar1 & "(" & cnt1 & ")")
        End If

        If cl.Value2 Like "*" & sVar2 & "*" Then
            bVar2 = True
            cnt2 = cnt2 + 1
            cl.Value2 = Replace(cl.Value, sVar2, sVar2 & "(" & cnt2 & ")")
        End If

        pos = InStr(1, cl.Value2, sVar1, vbTextCompare)
        If bVar1 Then cl.Characters(pos, Len(sVar1)).Font.Color = vbRed
        pos = InStr(1, cl.Value2, sVar2, vbTextCompare)
        If bVar2 Then cl.Characters(pos, Len(sVar2)).Font.Color = vbGreen

        bVar1 = False: bVar2 = False
    Next cl
End Sub

测试

Answer 2

更改单元格中部分值的格式

链接

Workbook Download

图片

代码

'*******************************************************************************
Sub CFF(Range As Range, SearchString As String, _
        Optional ColorIndex As Long = -4105, _
        Optional OccurrenceFirst0All1 As Long = 1, _
        Optional Case1In0Sensitive As Long = 1)

    ' ColorIndex
    '    3 for Red
    '   10 for Green
    ' OccurrenceFirst0All1
    '   0 - Only First Occurrence of SearchString in cell of Range.
    '   1 (Default) - All occurrences of SearchString in cell of Range.
    ' Case1In0Sensitive
    '   0 - Case-sensitive i.e. aaa <> AaA <> AAA
    '   1 (Default) - Case-INsensitive i.e. aaa = AaA = AAA

    Const cBold As Boolean = False  ' Enable Bold (True) for ColorIndex <> -4105

    Dim i As Long         ' Row Counter
    Dim j As Long         ' Column Counter
    Dim rngCell As Range  ' Current Cell Range
    Dim lngStart As Long  ' Current Start Position
    Dim lngChars As Long  ' Number of characters (Length) of SearchString

    ' Assign Length of SearchString to variable.
    lngChars = Len(SearchString)

    ' In Range.
    With Range
        ' Loop through rows of Range.
        For i = .Row To .Row + .Rows.Count - 1
            ' Loop through columns of Range.
            For j = .Column To .Column + .Columns.Count - 1
                ' Assign current cell range to variable.
                Set rngCell = .Cells(i, j)
                ' Calculate the position of the first occurrence
                ' of SearchString in value of current cell range.
                lngStart = InStr(1, rngCell, SearchString, Case1In0Sensitive)
                If lngStart > 0 Then ' SearchString IS found.
                    If OccurrenceFirst0All1 = 0 Then ' FIRST occurrence only.
                        GoSub ChangeFontFormat
                      Else ' ALL occurrences.
                        Do
                            GoSub ChangeFontFormat
                            lngStart = lngStart + lngChars
                            lngStart = InStr(lngStart, rngCell, SearchString, _
                                    Case1In0Sensitive)
                        Loop Until lngStart = 0
                    End If
                  'Else ' SearchString NOT found.
                End If
            Next
        Next
    End With

Exit Sub

ChangeFontFormat:
    ' Font Formatting Options
    With rngCell.Characters(lngStart, lngChars).Font
        ' Change font color.
        .ColorIndex = ColorIndex
        ' Enable Bold for ColorIndex <> -4105
        If cBold Then
            If .ColorIndex = -4105 Then  ' -4105 = xlAutomatic
                .Bold = False
              Else
                .Bold = True
            End If
        End If
    End With
    Return

End Sub
'*******************************************************************************

实际使用范围（RUR）

'*******************************************************************************
' Purpose:    Returns the Real Used Range of a worksheet.
' Returns:    Range Object or "Nothing".
'*******************************************************************************
Function RUR(Optional NotActiveSheet As Worksheet) As Range

    Dim objWs As Worksheet

    If Not NotActiveSheet Is Nothing Then
        Set objWs = NotActiveSheet
    Else
        Set objWs = ActiveSheet
    End If

    If objWs Is Nothing Then Exit Function

    Dim HLP As Range   ' Cells Range
    Dim FUR As Long    ' First Used Row Number
    Dim FUC As Long    ' First Used Column Number
    Dim LUR As Long    ' Last Used Row Number
    Dim LUC As Long    ' Last Used Column Number

    With objWs.Cells
        Set HLP = .Cells(.Cells.Count)
        Set RUR = .Find("*", HLP, xlFormulas, xlWhole, xlByRows)
        If Not RUR Is Nothing Then
            FUR = RUR.Row
            FUC = .Find("*", HLP, , , xlByColumns).Column
            LUR = .Find("*", , , , xlByRows, xlPrevious).Row
            LUC = .Find("*", , , , xlByColumns, xlPrevious).Column
            Set RUR = .Cells(FUR, FUC) _
                    .Resize(LUR - FUR + 1, LUC - FUC + 1)
        End If
    End With

End Function
'*******************************************************************************

用法

如果将以下代码与Change1Reset0参数设置为1一起使用，将在区分大小写 IN 的每次搜索中更改所需字符串的格式。

'*******************************************************************************
Sub ChangeStringFormat(Optional Change1Reset0 As Long = 0)

    Const cSheet As Variant = "Sheet1"
    Const cStringList As String = "WUG-FGT,INZL-DRE"
    Const cColorIndexList As String = "3,10"   ' 3-Red, 10-Green
    ' Note: More strings can be added to cStringList but then there have to be
    ' added more ColorIndex values to cColorIndexList i.e. the number of
    ' elements in cStringList has to be equal to the number of elements
    ' in cColorIndexList.

    Dim rng As Range      ' Range
    Dim vntS As Variant   ' String Array
    Dim vntC As Variant   ' Color IndexArray
    Dim i As Long         ' Array Elements Counter

    Set rng = RUR(ThisWorkbook.Worksheets(cSheet))

    If Not rng Is Nothing Then
        vntS = Split(cStringList, ",")
        If Change1Reset0 = 1 Then
            vntC = Split(cColorIndexList, ",")
            ' Loop through elements of String (ColorIndex) Array
            For i = 0 To UBound(vntS)
                ' Change Font Format.
                CFF rng, CStr(Trim(vntS(i))), CLng(Trim(vntC(i)))
            Next
          Else
            For i = 0 To UBound(vntS)
                ' Reset Font Format.
                CFF rng, CStr(Trim(vntS(i)))
            Next
        End If
    End If

End Sub
'*******************************************************************************

以前的代码应全部位于标准模块中，例如Module1。

CommandButtons

以下代码应位于创建命令按钮的工作表窗口中，例如Sheet1。

Option Explicit

Private Sub cmdChange_Click()
    ChangeStringFormat 1
End Sub

Private Sub cmdReset_Click()
    ChangeStringFormat ' or ChangeStringFormat 0
End Sub

Answer 3

尝试：

Option Explicit

Sub test()

    Dim rng As Range, cell As Range
    Dim StartPosWUG As Long, StartPosINL As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Set rng = .UsedRange

        For Each cell In rng

            StartPosWUG = InStr(1, cell, "WUG-FGT")
            StartPosINL = InStr(1, cell, "INZL-DRE")

            If StartPosWUG > 0 Then
                With cell.Characters(Start:=StartPosWUG, Length:=Len("WUG-FGT")).Font
                    .Color = vbRed
                End With
            End If

            If StartPosINL > 0 Then
                With cell.Characters(Start:=StartPosINL, Length:=Len("INZL-DRE")).Font
                    .Color = vbGreen
                End With
            End If

        Next

    End With

End Sub