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

Question

我想改变文本的颜色细胞在MS Excel类似条件格式。我有不同的文本在一个小区内，例如“WUG-FGT” 或 “INZL-DRE”。我想格式的单元格（所有单元格在我的workshhet），像“WUG-FGT”定义的文本显示为红色和其他文本“INZL-DRE”绿色，但文字是在同一个小区。随着“sandard”条件格式我只得到了研究背景颜色。

类似的问题是这样的：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

测试

UPDATE

是否有可能算多久这个词已经被检测到。无论是写信给总金额为定义的细胞或什么也将是巨大的，与一个控制变量增加计数的数量在括号中的字后面？因此，在你的例子：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

Change Format of Parts of Values in Cells

链接

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下面的代码，将改变在不区分大小写的搜索所需的字符串在每次出现时的格式。

'*******************************************************************************
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。

CommandButton控件

下面的代码应在其中创建的CommandButton控件的片窗口，例如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