5

我想编写一个 VBA 函数来突出显示 excel 单元格中的特定文本。这可能吗？我一直在谷歌搜索，但目前还不清楚。

为了澄清，我想在特定列中搜索文本值（实际上是值列表），并以黄色突出显示匹配的文本。

注意：这是我最终做的：

  Sub Colors()


    Dim searchString As String
    Dim targetString As String
    Dim startPos As Integer

    searchString = "abc"
    targetString = Cells(2, 1).Value
    startPos = InStr(targetString, searchString)

    If startPos > 0 Then

        Cells(2, 1).Characters(startPos, Len(searchString)).Font.Color = vbRed

    End If


 End Sub
4

6 回答 6

15

这是基本原则，我假设自定义此代码不是您所要求的（因为没有提供有关此的详细信息）：

 Sub Colors()

 With Range("A1")
    .Value = "Test"
    .Characters(2, 2).Font.Color = vbGreen
 End With

 End Sub

简短的描述虽然不言自明：第一个“2”是指需要着色的第一个字符，第二个“2”是指长度。

于 2012-07-26T15:32:23.267 回答
6

这仅适用于试图突出显示单元格内的特定字符串模式的未来读者，

（这就是我解释问题的方式）您可以在此示例中设置在 F1 中搜索的字符串

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub
于 2012-07-26T18:47:44.877 回答
2

这是专门针对@t.ztrk 的答案，他在 Col1 中有城市，并在第 2 列中搜索这些城市。他在这里发布了他的问题： 是否可以在 excel 中查找和更改文本的颜色

我从另一个解决方案中借用了这段代码（对不起，如果它不是原来的）：https ://stackoverflow.com/a/11676031/8716187

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub

我知道这可能并不优雅，但我在几分钟内就完成了它以满足用户的需求。如果上面提供的解决方案 (1) 更灵活或 (2) 更高效，请提前道歉。也对我的 C++ 嵌套循环习惯感到抱歉。

@t.ztrk 您可以录制一个宏并停止它（删除那里的任何内容）或插入一个按钮控件并将代码粘贴到那里。不确定您对 VB 的熟悉程度。只需确保在运行宏之前在要处理的工作表上选择一个单元格（它应该在任何工作表上运行，并且可以在任何工作簿上运行）。 

Sub Macro1()
'Searches all text in Column 2 on a Sheet for the string located in Column 1
'If found it highlights that text
Dim ThisWB As Workbook
Dim ThisWS As Worksheet
Dim i As Integer
Dim y As Integer

Dim Col1 As Double
Dim Col2 As Double

Dim Col1_rowSTART As Double
Dim Col1_rowEND As Double

Dim Col2_rowSTART As Double
Dim Col2_rowEND As Double

Dim strTest As String
Dim strLen As Integer

'Set up parameter that we know
Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 1 'city column
Col2 = 2 'text search column
'Define Starting Row for each column
Col1_rowSTART = 1
Col2_rowSTART = 1
'Define ending row for each column
Col1_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col1).End(xlUp).Row
Col2_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col2).End(xlUp).Row

'Could be fancy and see which column is shorter ....
'Won't do that here

For i = Col1_rowSTART To Col1_rowEND
    'make a string out of each cell value in Col1
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)
    'Roll thorugh all of Column 2 in search of the target string
    For y = Col2_rowSTART To Col2_rowEND
        'Check if Col1 string is in Col2 String
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
        End If
    Next y
Next i

MsgBox ("City Search Complete!")

End Sub

这是您的测试屏幕截图。 在此处输入图像描述

干杯 - 继续学习和应用。-WWC

于 2017-12-07T16:56:27.397 回答
1

突出显示单元格中的文本的一个问题是字符串可能不止一次出现，因此代码应该真正检查是否还有更多。这是我对这个问题的解决方案：

Sub Colors()


    Dim searchTerms As Variant


    searchTerms = Array("searchterm1", "searchterm2",  "lastsearchterm")


    Dim searchString As String
    Dim targetString As String
    Dim offSet As Integer
    Dim colToSearch As Integer
    Dim arrayPos, rowNum As Integer

    colToSearch = 3


    For arrayPos = LBound(searchTerms) To UBound(searchTerms)
        For rowNum = 2 To 31124

            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colToSearch).Value

            x = HilightString(offSet, searchString, rowNum, colToSearc)

        Next rowNum
    Next arrayPos

 End Sub

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

            Dim x As Integer
            Dim newOffset As Integer
            Dim targetString As String


            ' offet starts at 1

            targetString = Mid(Cells(rowNum, ingredCol), offSet)

            foundPos = InStr(LCase(targetString), searchString)

            If foundPos > 0 Then

                ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
                Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbRed

                ' increment the offset to found position + 1 + the length of the search string
                newOffset = offSet + foundPos + Len(searchString)

                x = HilightString(newOffset, searchString, rowNum, ingredCol)
            Else
                ' if it's not found, come back out of the recursive call stack
                Exit Function
            End If
End Function
于 2012-07-27T16:30:41.207 回答
1

@Jack BeNimble 感谢代码，在 10 分钟内成功使用它来突出显示单元格中的所有数字。我对其进行了一点重组，首先搜索一行和单元格中的所有搜索词，并允许多列。我发现了一个错误，您的突出显示文本不喜欢重复 55、444，只突出显示序列中的奇数重复。修改高亮功能中的一行

newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.

这是我修改后的代码。

子编号颜色（）

Dim searchTerms As Variant


searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")


Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer

colsToSearch = Array(4, 44, 45)


For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
    colNum = colsToSearch(colIndex)
    For rowNum = 5 To 3000
        For arrayPos = LBound(searchTerms) To UBound(searchTerms)
            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colNum).Value

            x = HilightString(offSet, searchString, rowNum, colNum)
        Next arrayPos
    Next rowNum
Next colIndex

结束子

函数 HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer

        Dim x As Integer
        Dim newOffset As Integer
        Dim targetString As String


        ' offet starts at 1

        targetString = Mid(Cells(rowNum, ingredCol), offSet)

        foundPos = InStr(LCase(targetString), searchString)

        If foundPos > 0 Then

            ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue

            ' increment the offset to found position + 1 + the length of the search string
            newOffset = offSet + foundPos + Len(searchString) - 1

            x = HilightString(newOffset, searchString, rowNum, ingredCol)
        Else
            ' if it's not found, come back out of the recursive call stack
            Exit Function
        End If

结束功能

谢谢 Jack BeNimble 和数据

于 2017-09-22T16:59:04.090 回答
-2

您不需要 VBA 来执行此操作。您可以使用条件格式。

假设您在 E 列中有一组值。您想在单元格 B1 中输入一个值并突出显示 E 列中与该值匹配的单元格。

突出显示 E 列中的单元格并应用以下条件格式：

突出显示匹配的单元格

更改颜色以适合。这会将相对条件格式应用于 E 列中的单元格。例如：选择 E3 并查看条件格式，它应该如下所示：

相对参考

您可以看到公式如何自行调整。

（编辑：如果要将 B1 中的值与 E 列中的值的子字符串匹配，请改用此条件格式公式=FIND($B$1,E1)>0：）

现在在单元格 B1 中键入不同的值。如果您键入的值与 E 列中的某个值匹配，则这些单元格（在 E 列中）将改变颜色。将单元格 B1 更改为 E 列中不存在的值，格式将消失。

于 2012-07-26T15:53:59.733 回答