在Vba excel上突出显示搜索到的单词

时间:2016-02-16 15:59:19

标签: excel vba excel-vba

我试图在突出显示和搜索的单词中添加一个计数到目前为止我添加了icount作为一个字符串,它有时最多只计数1,我认为我的公式可能是错的,我的室友也很好用c并认为我应该将icount更改为字符串为long或integer。

Sub highlightext()

 Application.ScreenUpdating = False

 Dim ws As Worksheet
 Set ws = Worksheets("Sheet1")

 Dim oRange As Range
 Set oRange = ws.Cells


  Dim wordToFind As String
  wordToFind = InputBox(Prompt:="What word would you like to highlight?")

 Dim cellRange As Range
 Set cellRange = oRange.Find(What:=wordToFind, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows,  SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

If Not cellRange Is Nothing Then

Dim Foundat As String
Foundat = cellRange.Address
Set outws = Worksheets("product")
outws.Range("A2").Value = wordToFind


Do

    Dim textStart As Integer
    textStart = 1

    Do

        textStart = InStr(textStart, LCase(cellRange.Value), LCase(wordToFind))
        If textStart <> 0 Then
            cellRange.Characters(textStart, Len(wordToFind)).Font.Color = RGB(250, 0, 0)
            textStart = textStart + 1



        End If


    Loop Until textStart = 0


    Set cellRange = oRange.FindNext(After:=cellRange)

Loop Until cellRange Is Nothing Or cellRange.Address = Foundat

End If





 Dim icount() As String

 icount = Split(Foundat, ", ")

 outws.Range("B2").Value = UBound(icount) + 1



 End Sub

1 个答案:

答案 0 :(得分:3)

下面经过全面测试的代码和屏幕截图。

Sub highlightext()

Application.ScreenUpdating = False

Dim ws As Worksheet
Set ws = Worksheets("Sheet1")

Dim oRange As Range
Set oRange = ws.Range("A:A")

Dim wordToFind As String
wordToFind = InputBox(Prompt:="What word would you like to highlight?")

Dim cellRange As Range
Set cellRange = oRange.Find(What:=wordToFind, LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

If Not cellRange Is Nothing Then

    Dim Foundat As String
    Foundat = cellRange.Address

    Do

        Dim textStart As Integer
        textStart = 1

        Do

            'to compare lower case only use this
            'textStart = InStr(textStart, LCase(cellRange.Value), LCase(wordToFind))
            textStart = InStr(textStart, cellRange.Value, wordToFind)
            If textStart <> 0 Then
                cellRange.Characters(textStart, Len(wordToFind)).Font.Color = RGB(250, 0, 0)
                textStart = textStart + 1
            End If


        Loop Until textStart = 0

        Set cellRange = oRange.FindNext(After:=cellRange)

    Loop Until cellRange Is Nothing Or cellRange.Address = Foundat

End If

End Sub

enter image description here

在单词中可能会出现一些错误(例如Scott中的Scott,在我的示例中,或Scott中的Scott )。也许这些适用于您或不适用,因此您可能需要进行一些调整。