我试图在突出显示和搜索的单词中添加一个计数到目前为止我添加了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
答案 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
在单词中可能会出现一些错误(例如Scott
中的Scott
,在我的示例中,或Scott
中的Scott
)。也许这些适用于您或不适用,因此您可能需要进行一些调整。