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

很费力：

检测到细胞在感兴趣的范围内发生了变化
使用UnDo获取原始内容
使用ReDo获取新内容
比较它们以获取更改的字符
使用单元格的Characters属性格式化新字符

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

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

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

Answer 3

这会改变字体，但并不完美。如果你在同一个单元格中有不同的字体颜色，那么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 4

使用Gary的学生提示，我保留了旧单元格的值，并与新值进行比较。然后使用长度来获得差异＆＃39;并为'＃39;字符着色。以下是修改：

P.S。对不起我的英文

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

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

5 个答案: