Question

我的程序基本上突出显示用户选择字体颜色的文本中的关键字。我只有在用户指定的单元格中显示搜索项而不是实际执行程序时才会出现问题。我使用术语输入，范围/单元格来显示这些术语，来自用户的字体颜色。这是部分代码：

 Dim Ran As String
          searchTerms = InputBox("Please enter words to search, if more than one string seperate by comma and space", "Need Input", 1)


       Ran = InputBox("Please enter cell where you want the search terms to be displayed ideally below verbatim like C2,D2 ", "Need Input", 0, 8)
      r = Range(Ran).Row
      c = Range(Ran).Column

       If IsEmpty(Cells(r, 1)) And c <> "A" Then
         Range(Ran).Value = Range(Ran).Value & ", " & searchTerms
        Else: Range(Ran).EntireRow.Insert
        Range(Ran).Value = searchTerms
        End If

       searchTerms = Split(UCase(searchTerms), ", ")

这对于2次执行是按预期工作的，但是对于第三次执行，先前的执行字体颜色更改为第1次执行颜色。如何强制它在执行前保持原样。假设在第一次执行后它是黄色的，在第二次执行后附加的变量是绿色的，然后当我执行第三次执行时，整个单元格内容在执行之前变为黄色，并且只有第三个执行项将变为用户定义的字体颜色。但第二个执行附加术语将为黄色作为第一个执行颜色。这是突出显示功能的代码：

Function HilightString(offSet As Integer, searchString As String, rowNum As Long, ingredCol As String, FontColor, fontSize As Integer) As Integer

        Dim x As Integer
        Dim newOffset As Integer
        Dim targetString As Variant

         If Cells(rowNum, ingredCol).HasFormula Then
Cells(rowNum, ingredCol).Value = "'" & Cells(rowNum, ingredCol).Formula
End If
        targetString = Mid(Cells(rowNum, ingredCol), offSet)
        foundPos = InStr(UCase(targetString), searchString)

        If foundPos > 0 Then

            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.ColorIndex = FontColor

            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Size = 14

            newOffset = offSet + foundPos + Len(searchString)

            x = HilightString(newOffset, searchString, rowNum, ingredCol, FontColor, fontSize)
        Else

            Exit Function

        End If
 End Function

第一次执行突出显示转向，蓝色信号并在单元格c2中创建：

第二次执行突出显示后面的绿色它正常工作到

在完成第三次执行之前，突出显示闪烁

第3次执行后。第二个执行的单词变回蓝色

Answer 1

执行此操作时添加新单词：

Range(Ran).Value = Range(Ran).Value & ", " & searchTerms

您不能保留多种颜色的文本 - 替换内容只会为整个单元格提供第一个字母的颜色。第一次和第二次运行都没问题，但是从第3次运行开始就会失败。

您需要使用Characters集合添加新文本，而不是替换整个单元格内容。

示例：

Sub Tester()

    Dim c As Range
    Set c = Range("A1")

    AddTextWithColor c, "first", vbRed
    AddTextWithColor c, "second", vbBlue
    AddTextWithColor c, "third", vbGreen

End Sub

Sub AddTextWithColor(c As Range, txt As String, clr As Long)
    Dim l As Long
    With c
        If Len(.Value) = 0 Then
            .Value = txt
        Else
            l = .Characters.Count
            'adds the new text without replacing existing formatting
            .Characters(l + 1, Len(txt) + 2).Text = "," & txt
        End If
        With .Characters(IIf(l = 0, 1, l + 2), Len(txt)).Font
            .Color = clr
            .Size = 14
        End With
    End With
End Sub

如何强制字体颜色保持原样而不是更改

1 个答案: