更改 excel 单元格中文本的颜色
Change color of text in a cell of excel
我想像条件格式一样更改 MS Excel 中单元格中文本的颜色。我在一个单元格中有不同的文本，例如"WUG-FGT" 或 "INZL-DRE"。我想格式化单元格（我的 workshhet 中的所有单元格），定义的文本如 "WUG-FGT" 显示为红色，而其他文本 "INZL-DRE" 显示为绿色，但文本位于同一单元格中。使用 "sandard" 条件格式，我只能将背景着色。
类似的问题是：
但不同的是我（实际上）不从事编程工作。这意味着我需要一个更简单或更容易的解决方案来在我的 excel 文件中实现它。
这可能吗？ VBA 的解决方案也是可能的，我知道如何实现它们。
此处示例如何实现所需结果：
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
测试
更新
Is it possible to count how often the word has been detected. Either to write to total amount to a defined cell or what also would be great, to add the number of counts in brackets behind the word with an control variable? So in your example: 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
测试
尝试：
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
更改单元格中部分值的格式
链接
图片
代码
'*******************************************************************************
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
'*******************************************************************************
用法
以下代码如果与设置为 1 的 Change1Reset0 参数一起使用，将在 case-IN[=45] 中每次出现所需字符串时更改格式=]敏感搜索。
'*******************************************************************************
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.
命令按钮
以下代码应位于创建命令按钮的 sheet window 中，例如Sheet1.
Option Explicit
Private Sub cmdChange_Click()
ChangeStringFormat 1
End Sub
Private Sub cmdReset_Click()
ChangeStringFormat ' or ChangeStringFormat 0
End Sub
我想像条件格式一样更改 MS Excel 中单元格中文本的颜色。我在一个单元格中有不同的文本，例如"WUG-FGT" 或 "INZL-DRE"。我想格式化单元格（我的 workshhet 中的所有单元格），定义的文本如 "WUG-FGT" 显示为红色，而其他文本 "INZL-DRE" 显示为绿色，但文本位于同一单元格中。使用 "sandard" 条件格式，我只能将背景着色。
类似的问题是：
但不同的是我（实际上）不从事编程工作。这意味着我需要一个更简单或更容易的解决方案来在我的 excel 文件中实现它。
这可能吗？ VBA 的解决方案也是可能的，我知道如何实现它们。
此处示例如何实现所需结果：
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
测试
更新
Is it possible to count how often the word has been detected. Either to write to total amount to a defined cell or what also would be great, to add the number of counts in brackets behind the word with an control variable? So in your example: 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
测试
尝试：
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
更改单元格中部分值的格式
链接
图片
代码
'*******************************************************************************
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
'*******************************************************************************
用法
以下代码如果与设置为 1 的 Change1Reset0 参数一起使用，将在 case-IN[=45] 中每次出现所需字符串时更改格式=]敏感搜索。
'*******************************************************************************
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.
命令按钮
以下代码应位于创建命令按钮的 sheet window 中，例如Sheet1.
Option Explicit
Private Sub cmdChange_Click()
ChangeStringFormat 1
End Sub
Private Sub cmdReset_Click()
ChangeStringFormat ' or ChangeStringFormat 0
End Sub