大家早上好,我正在创建一个 Excel 宏来查找单词并标记单词和单元格。我想找到我的数组中的单词。我遇到的问题是它标记了它找到的所有单词,即使它包含在另一个单词中。例如:我有“skin”这个词,它标记了“Asking”这个词,所以它在“Asking”这个词中标记了“skin”这个词,而我只想标记“skin”这个词。我有办法改变这个吗?
这里有我的代码。
Dim med_Arr As Integer
Dim ws As Worksheet
Dim oRange As Range
Dim wordToFind As String
Dim Lista As Variant
Dim cellRange As Range
Dim Foundat As String
For Each ws In ActiveWorkbook.Worksheets ' for
Set oRange = ws.Range("M:M")
ws.Activate
Lista = Array("BRAKE", "OIL", "FALL", "CUT", _
"EXPOSED", "COPPER", "TREND", "NO ALARM", _
"NOT ALARM", "ALARM IN", "SORE", "BURN", _
"SPARK", "FLUID", "PAIN", "BLOOD", "MOULD", _
"HURT", "ITSELF", "SEVERED", "BLISTER", _
"SELF RUN", "STAY UP", "SKIN", "STAYING UP", _
"BUZZER", "HEAT", "LATCH", "SPLIT", "VOICE", _
"FIRE", "SMOKE", "HOT", "FRAY", "VOLUME", _
"BED EXIT", "COLLAPSE", "WARNING", "LABEL", _
"HEART MO", "HHR", "RESPIRATORY MONITOR", _
"COMMUNICATING", "HR NO", "10 C0", "CONTAMINATION", _
"INGRESS", "EGRESS", "SAFETY", "INJURED", "DIED", _
"FELL", "WARM", "TILT", "TIPP", "UNSTABLE", "ARC", _
"VITAL SIGN", "SHOCK", "FLICKER", "ELECTROCUTED", _
"SHARP", "SLICE", "LACERAT", "ELECTROMAG", "FLAM", _
"IN HALF", "MUTILA", "EARLYSENSE", "EARLY SENSE", _
"ENTRAP", "DROP")
med_Arr = UBound(Lista) - LBound(Lista) 'LBound (0)
For i = 0 To med_Arr 'for loop From 0 to Array Length
wordToFind = Lista(i) 'saves word to find
Set cellRange = oRange.Find(What:=wordToFind, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) ' Finds first cell that contains at least one word and sets it to cell range
If Not cellRange Is Nothing Then ' cell range exists then
Foundat = cellRange.Address ' variable that contains address of cell that contains the word
Do ' create variable textStart and set it to 1
Dim textStart As Integer
textStart = 1
Do
textStart = InStr(textStart, cellRange.Value, wordToFind) ' set position of current word found to textStart
If textStart <> 0 Then ' if textStart different than zero, then it didn't find anything
cellRange.Characters(textStart, Len(wordToFind)).Font.Color = RGB(250, 0, 0) ' font Color-red
cellRange.Characters(textStart, Len(wordToFind)).Font.Bold = True 'bold
cellRange.Interior.ColorIndex = 40 'background color to 40
textStart = textStart + 1 ' increase one to textStart (position) to check if there's more words to look for in the rest of the paragraph
End If
Loop Until textStart = 0 ' loop again
Set cellRange = oRange.FindNext(After:=cellRange) ' set cellRange and find if there's another word in the rest of the paragraph
Loop Until cellRange Is Nothing Or cellRange.Address = Foundat ' loop until cellRange is empty or the cellRange adress is equal to the current cell
End If
Next i
Next
感谢您的时间和帮助。
最佳答案
这是使用 VBsript Regexp 对象的方法:
Option Explicit
Sub RunHighlights()
Dim ws As Worksheet, c As Range
'loop over worksheets
For Each ws In ActiveWorkbook.Worksheets ' for
For Each c In ws.Range("M1", ws.Cells(Rows.Count, "M").End(xlUp)).Cells
If Len(c.Value) > 0 Then
'highlight cell if any matches
c.Interior.ColorIndex = IIf(HighlightWords(c) > 0, 40, xlNone)
End If
Next c
Next ws
End Sub
'Highlight all words in a cell matching anything in WordList,
' and return number of matches
Function HighlightWords(c As Range) As Long
Dim re As Object, txt As String, matches As Object, m, rv As Long
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "\b(" & Join(WordList(), "|") & ")\b" 'join word array to create pattern
' \b = word boundary
re.ignorecase = True
re.MultiLine = True
re.Global = True 'match whole text
c.Font.Color = vbBlack 'reset any existing coloring
Set matches = re.Execute(c.Value)
For Each m In matches 'loop each match and apply font color
Debug.Print c.Parent.Name, c.Address, m, m.firstindex, m.Length
c.Characters(m.firstindex + 1, m.Length).Font.Color = vbRed
rv = rv + 1
Next m
HighlightWords = rv 'return # of matches
End Function
'just returns an array of words to match on
Function WordList()
WordList = Array("BRAKE", "OIL", "FALL", "CUT", _
"EXPOSED", "COPPER", "TREND", "NO ALARM", _
"NOT ALARM", "ALARM IN", "SORE", "BURN", _
"SPARK", "FLUID", "PAIN", "BLOOD", "MOULD", _
"HURT", "ITSELF", "SEVERED", "BLISTER", _
"SELF RUN", "STAY UP", "SKIN", "STAYING UP", _
"BUZZER", "HEAT", "LATCH", "SPLIT", "VOICE", _
"FIRE", "SMOKE", "HOT", "FRAY", "VOLUME", _
"BED EXIT", "COLLAPSE", "WARNING", "LABEL", _
"HEART MO", "HHR", "RESPIRATORY MONITOR", _
"COMMUNICATING", "HR NO", "10 C0", "CONTAMINATION", _
"INGRESS", "EGRESS", "SAFETY", "INJURED", "DIED", _
"FELL", "WARM", "TILT", "TIPP", "UNSTABLE", "ARC", _
"VITAL SIGN", "SHOCK", "FLICKER", "ELECTROCUTED", _
"SHARP", "SLICE", "LACERAT", "ELECTROMAG", "FLAM", _
"IN HALF", "MUTILA", "EARLYSENSE", "EARLY SENSE", _
"ENTRAP", "DROP")
End Function
关于excel - 我使用“查找”功能在 vba Excel 中查找单词,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/65890478/