VBA – 更改修改文本的颜色

我有这个代码，如果它被修改，改变单元格中的文本的颜色。 不过，我正在研究只改变单元格内修改文本颜色的东西。 例如，我在单元格A1 =“这个单元格”，当我把它改为“这个单元格 – 这是新的文本”我只想改变颜色“ – 这是新的文本”

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Font.ColorIndex = 3 Then Target.Font.ColorIndex = 5 Else Target.Font.ColorIndex = 3 End If End If End Sub 

谢谢

Answer 1

使用加里的学生的提示，我保留细胞的旧价值，并与新的价值进行比较。 然后使用长度来获得“差异”并为“angular色”着色。 这是修改：

 Option Explicit Public oldValue As Variant Public Sub Worksheet_SelectionChange(ByVal Target As Range) oldValue = Target.Value End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim oldColor If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Value <> oldValue Then oldColor = Target.Font.ColorIndex Target.Characters(Len(oldValue) + 1, Len(Target) - Len(oldValue)).Font.ColorIndex = IIf(oldColor = 3, 5, 3) End If End If End Sub 

PS抱歉我的英语

Answer 2

这是我放在一起的：

 Dim oldString$, newString$ Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then newString = Target.Value If Target.Font.ColorIndex = 3 Then Target.Font.ColorIndex = 5 Else Target.Font.ColorIndex = 3 End If End If Debug.Print "New text: " & newString color_New_Text oldString, newString, Target End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then oldString$ = Target.Value Debug.Print "Original text: " & oldString$ End If End Sub Sub color_New_Text(ByVal oldString As String, ByVal newString As String, ByVal theCell As Range) Dim oldLen&, newLen&, i&, k& oldLen = Len(oldString) newLen = Len(newString) Debug.Print newString & ", " & oldString For i = 1 To newLen If Mid(newString, i, 1) <> Mid(oldString, i, 1) Then Debug.Print "different" Debug.Print theCell.Characters(i, 1).Text If theCell.Characters(i, 1).Font.ColorIndex = 3 Then theCell.Characters(i, 1).Font.ColorIndex = 5 Else theCell.Characters(i, 1).Font.ColorIndex = 3 End If End If Next i End Sub 

这是两个全局variables， Worksheet_SelectionChange和Worksheet_Change来获取string。

Answer 3

这很辛苦：

1. 检测到细胞在感兴趣的范围内已经改变
2. 使用UnDo获取原始内容
3. 使用ReDo获取新内容
4. 比较他们得到改变的字符
5. 使用单元格的Characters属性来格式化新的字符

我会使用UnDo来避免保留每个100个单元格的static副本。

Answer 4

这将改变字体，但它并不完美。 似乎如果你在同一个单元格中有不同的字体颜色，那么Target.Font.ColorIndex返回NULL，所以它只能在第一次改变时起作用。

 Option Explicit Dim sOldValue As String Private Sub Worksheet_Change(ByVal Target As Range) Dim sNewValue As String Dim sDifference As String Dim lStart As Long Dim lLength As Long Dim lColorIndex As Long On Error GoTo ERROR_HANDLER If Not Intersect(Target, Range("A1:A100")) Is Nothing Then sNewValue = Target.Value sDifference = Replace(sNewValue, sOldValue, "") lStart = InStr(sNewValue, sDifference) lLength = Len(sDifference) If Target.Font.ColorIndex = 3 Then lColorIndex = 5 Else lColorIndex = 3 End If Target.Characters(Start:=lStart, Length:=lLength).Font.ColorIndex = lColorIndex End If On Error GoTo 0 Exit Sub ERROR_HANDLER: Select Case Err.Number 'I haven't added error handling - trap any errors here. Case Else MsgBox "Error " & Err.Number & vbCr & _ " (" & Err.Description & ") in procedure Sheet1.Worksheet_Change." End Select End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then sOldValue = Target.Value End If End Sub 

编辑：它只会使用连续的string。 也许可以改变看sOldValue和sNewValue中的每个字符并根据需要改变颜色。

Answer 5

试试下面

 Private Sub Worksheet_Change(ByVal Target As Range) Dim newvalue As String Dim olvalue As String Dim content Application.EnableEvents = False If Not Intersect(Target, Range("A1:A100")) Is Nothing Then If Target.Font.ColorIndex <> -4105 Or IsNull(Target.Font.ColorIndex) = True Then newvalue = Target.Value Application.Undo oldvalue = Target.Value Content = InStr(newvalue, Replace(newvalue, oldvalue, "")) Target.Value = newvalue With Target.Characters(Start:=Content, Length:=Len(newvalue)).Font .Color = 5 End With Else Target.Font.ColorIndex = 3 End If End If Application.EnableEvents = True End Sub