VBA - 更改修改后文本的颜色

Question

我有这段代码，如果它被修改，它会改变单元格中文本的颜色。但是，我正在研究只改变单元格内修改文本颜色的东西。例如，我在单元格 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

这是我整理的：

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

这是两个全局变量，一个Worksheet_SelectionChange和Worksheet_Change来获取字符串。

Answer 2

很辛苦：

1. 检测到感兴趣范围内的单元格发生了变化
2. 使用UnDo获取原始内容
3. 使用ReDo获取新内容
4. 比较它们以获得更改的字符
5. 使用单元格的Characters 属性来设置新字符的格式

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

Answer 3

使用 Gary's Student 的提示，我保留了 cell 的旧值并与新值进行比较。然后使用长度来获得“差异”并为“字符”着色。修改如下：

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

附：对不起我的英语

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

编辑：它只适用于连续字符串。也许可以更改为查看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