Я думаю, что единственный способ - это VBA, поэтому я нарушил правила написания макроса (... извините) для вас, который может достичь этого быстро. Он будет окрашивать каждое вхождение поискового запроса оранжевым и сообщать вам, сколько вхождений он находит. Вы можете создать ярлык к нему, как CTRL+SHIFT+F (как специальный CTRL+F).
Кстати, он работает так же, как CTRL+F, что касается выбора. Другими словами, если выбрана только одна ячейка, то выполняется поиск по всему листу ... но если выбран диапазон ячеек, он проверяет только этот конкретный диапазон, как обычная функция Find.
Вот пример результата:
А вот и VBA:
Sub findPaintString()
Dim values As Range
Dim LastRow As Long, LastCol As Integer
myName = "Find+Paint String"
'We'll work like the normal Find/Replace function which looks at the selected range...
Set values = Selection
'...if the selected range is one cell then we look at the entire worksheet (within the used range):
If values.Cells.Count = 1 Then
LastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set values = Range(Cells(1, 1), Cells(LastRow, LastCol))
End If
'Set a suggested/default search query if you repeatedly search the same word:
strSearch = ""
'Get the string to paint:
theString = CStr(InputBox("Enter the string you want to paint" & vbNewLine & "(not case sensitive):", myName, strSearch))
If theString = "" Then Exit Sub
'Set the colour to paint occurrences:
theColour = 1137094
'Make a log of occurrences:
foundLog = 0
'Work through each cell in range, searching for the string and painting it:
For Each cell In values
'Check if our string is somewhere in the cell - if not then ignore it:
If InStr(LCase(cell.Value), LCase(theString)) Then
matchLog = 0 'match success log (increments by 1 per character)
j = 1 ' string character selector
For i = 1 To cell.Characters.Count
If LCase(Mid(cell.Value, i, 1)) = LCase(Mid(theString, j, 1)) Then
matchLog = matchLog + 1 '+1 to matchlog
j = j + 1 '+1 to string character selector
If matchLog = Len(theString) Then
'we have found the full word, so paint it:
cell.Characters(i - Len(theString) + 1, Len(theString)).Font.Color = theColour
j = 1 'reset string character ready for next use
matchLog = 0 'reset matchLog ready for next use
foundLog = foundLog + 1
End If
Else
'reset matchLog and string character selector:
matchLog = 0
j = 1
'see if this cell character (which didn't match the string character that we
'got up to) matches the first string character:
If LCase(Mid(cell.Value, i, 1)) = LCase(Mid(theString, j, 1)) Then
matchLog = matchLog + 1
j = j + 1
End If
End If
Next i
End If 'in string
Next cell
'Tidy data for message box:
If Len(theString) > 20 Then theString = Left(theString, 16) & "..."
If foundLog = 0 Then
foundLog = "0"
theS = "s"
ElseIf foundLog = 1 Then
theS = ""
Else
theS = "s"
End If
MsgBox "Found " & foundLog & " occurrence" & theS & " of '" & theString & "'.", vbOKOnly, myName
End Sub
Это дело в чувствительном. Чтобы сделать его чувствительным к регистру, удалите четыре экземпляра LCase()
.
Если вы часто просматриваете одну и ту же строку, измените строку strSearch = ""
на [например] strSearch = "apples"
. Вы все еще можете перезаписать его при запуске.