vba 如何在excel中突出显示选定的文本

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/11672740/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 13:39:28  来源:igfitidea点击:

How to highlight selected text within excel

excelvbatexthighlight

提问by Hyman BeNimble

I would like to write a VBA function to highlight specific text within an excel cell. Is this possible? I've been googling but it's unclear at this point.

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

to clarify, I would like to search a specific column for a text value (actually a list of values) and highlight the matched text in say yellow.

澄清一下,我想在特定列中搜索文本值(实际上是值列表)并以黄色突出显示匹配的文本。

Note: this is what I ended up doing:

注意:这是我最终做的:

  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

回答by Trace

This is the basic principle, I assume that customizing this code is not what you are asking (as no details about this were provided):

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

 Sub Colors()

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

 End Sub

Small description although it speaks quite for itself: the first "2" refers to the first character that needs to be colored, the second "2" refers to the length.

小说明虽然不言自明:第一个“2”指的是需要着色的第一个字符,第二个“2”指的是长度。

回答by datatoo

This is only for future readers trying to highlight a specific string pattern inside of cells,

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

(which is how I had interpreted the question) You can set the string being searched for in F1 in this example

(这就是我解释问题的方式)您可以在此示例中设置在 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

回答by Wookies-Will-Code

This is answer is specifically for @t.ztrk who has cities in Col1 and text to search for those cities in column 2. He posted his question over here: is it possible to find and change color of the text in excel

这是专门针对@t.ztrk 的答案,他在 Col1 中有城市并在第 2 列中搜索这些城市的文本。他在这里发布了他的问题:Is it possible to find and change color of the text in excel

I borrowed from this code from another solution (sorry if it was not the original):https://stackoverflow.com/a/11676031/8716187

我从另一个解决方案中借用了此代码(对不起,如果它不是原始的):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

I know this might not be elegant but I punched it out in a few minutes to meet the users need. Sorry in advance if the solutions provided above are (1) more flexible or (2) more efficient. Also sorry for my C++ nested loop habits coming through.

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

@t.ztrk you can record a macro and just stop it (delete whatever is there) or insert a button control and paste the code there. Not sure what your VB familiarity is. Just be sure to select a cell on the worksheet you want to process before you run the macro (it should run on any sheet and can be made to work on any workbook).

@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

Here is your testing screenshot. enter image description here

这是您的测试屏幕截图。 在此处输入图片说明

Cheers - Keep learning and applying. -WWC

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

回答by Hyman BeNimble

One problem with highlighting text in a cell is that there could be more than one occurrence of the string, so the code should really check to see if there are any more. Here's my solution to that problem:

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

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

回答by Anthony Radler

@Hyman BeNimble thanks for the code, used it successfully in 10 mins to highlight all the numbers in a cell. I reorganized it a tad, searching all search terms within a row and cell first and allowed for multiple columns. I found one error, your highlight text didn't like repeats 55, 444, only highlighted the odd repeats in a sequence. Modified one line in Highlight Function

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

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

here is my modified code.

这是我修改后的代码。

Sub NumberColors()

子编号颜色()

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

End Sub

结束子

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

函数 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

End Function

结束函数

Thanks Hyman BeNimbleand datatoo

感谢 Hyman BeNimbleand datatoo

回答by JimmyPena

You don't need VBA to do this. You can use Conditional Formatting.

你不需要 VBA 来做到这一点。您可以使用条件格式。

Let's say you have a set of values in column E. You want to enter a value in cell B1 and highlight the cells in column E that match that value.

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

Highlight the cells in column E and apply the following conditional formatting:

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

highlight matching cells

突出显示匹配的单元格

Change the color(s) to suit. This will apply relative conditional formatting to the cells in column E. Ex: select E3 and view the conditional formatting, it should look like this:

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

relative reference

相对参考

You can see how the formula adjusted itself.

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

(Edit:If you want to match the value in B1 to a substring of a value in column E, use this conditional formatting formula instead: =FIND($B$1,E1)>0)

编辑:如果你想在B1的价值相符的E列的值的子串,使用条件格式公式改为:=FIND($B$1,E1)>0

Now type different values in cell B1. If you type a value that matches one of the values in column E, those cells (in column E) will change color. Change cell B1 to a value that does not exist in column E, the formatting disappears.

现在在单元格 B1 中键入不同的值。如果您键入的值与 E 列中的值之一匹配,则这些单元格(在 E 列中)将更改颜色。将单元格 B1 更改为 E 列中不存在的值,格式消失。