在VBA excel上突出search词

我正在尝试在单词突出显示和search到目前为止，我添加icount作为一个string，它只能计数到1有时2，我认为我的公式可能是错误的，也是我的室友与C好，并认为我应该将icount作为一个string更改为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 

Answer 1

完全testing下面的代码和截图去与它。

 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 

有一些陷阱可能会出现某些单词的话（如Scott在Scott ，在我的例子，或Scott在Scott的）。 也许这些会适用于你的或不是，所以你可能需要做一些调整。