繁体   English   中英

我使用 Find 函数在 vba Excel 中查找单词

I use the Find function to find words in vba Excel

提示:本站收集StackOverFlow近2千万问答,支持中英文搜索,鼠标放在语句上弹窗显示对应的参考中文或英文, 本站还提供   中文繁体   英文版本   中英对照 版本,有任何建议请联系yoyou2525@163.com。

大家早上好,我正在创建一个 excel 宏来查找单词并标记单词和单元格。 我想在我的数组中找到我的单词。 我遇到的问题是它标记了它找到的所有单词,即使它包含在另一个单词中。 例如:我有单词skin,它标记了单词“A skin g”,所以它标记了单词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

我感谢您的时间和帮助。

1 个回复

这是使用 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
1 在Excel中查找多个单词并使用VBA删除行

我尝试根据我在堆栈中找到的两个脚本创建自己的脚本,但无法使其正常运行。 因此,我想做的是在excel文档中找到某些单词,然后删除数据所在的行。 我要查找的字符串模式最终会随着时间增长,因此我需要能够更新数组并让我的vba脚本删除与该模式匹配的任何行。 ...

2 使用VBA在Excel中的MS Word上查找和替换单词

我是VBA的新手。 我一直想在Excel中使用VBA来选择并打开MS Word文档。 然后,我想用我的Excel文档中的值替换特定单词的所有实例(假设其在单元格A1中)。 到目前为止,我设法打开了select并打开了文件,并从A1中读取了信息,但是我在查找时遇到了麻烦,并用Word Doc替换了 ...

2020-08-12 17:15:26 0 19   excel/ vba
3 如何通过 vba 代码 Cells.Find 在 excel 列中查找值

我必须在 Excel 工作表中找到一个值celda 。 我正在使用此 vba 代码来查找它: 问题是当我必须仅在 excel 列中查找值时。 我用下一个代码找到它: 但是我不知道如何使它适应第一个 vba 代码,因为我必须使用值nothing 。 ...

2013-02-18 07:58:36 4 620834   vba/ excel
4 使用VBA在Excel中查找最后一行的函数

我正在尝试构建一个具有1个单元格输入的简单函数,该函数将抵消此卷中最后一个连续填充的单元格。 由于某种原因,这是行不通的... 在没有VBA的情况下,我可以通过以下方式获得所需的结果: =LOOKUP(9E+50,B:B) 。 不是很优雅,也不总是有用。 ...

2015-07-21 22:02:23 4 484   excel/ vba
5 如何在.FIND中使用MAX? 在VBA(Excel)中

我已经在这个问题上工作了一段时间了,似乎无法解决它。 我有以下VBA代码,我想获取range1的Resize的最大值。 我尝试过将MAX放在开始,结束以及其他我能想到的其他地方。 这是现在没有MAX的情况: 这是我最近一次修改上面的代码以包含MAX的尝试: ...

6 Excel 2010 VBA:如何在使用Range.Find()时保存/缓存查找参数?

我以前做过这个,但已经很多年了。 拿这个代码: 这在我拥有的宏中运行。 问题是,当我使用CTRL + F进行常规查找时,我的宏代码中使用的参数将被保存。 我通常喜欢在单元格内容中搜索,而不是像上面代码那样搜索整个单元格。 扩展查找选项并在每次打开查找窗口时取消选中“匹配整个单元格 ...

8 使用FIND函数返回VBA中的最后一个值

我正在尝试编写一个搜索列的函数并返回包含最后一个匹配项的单元格。 例如,如果我将单元格A5作为活动单元格 我想在数组中搜索“文本”,并返回单元格A3,因为这是最后一个匹配项。 但是,如果我将单元格A7作为活动单元格 然后它将返回A6作为我的结果。 我一直在尝试使 ...

9 在MongoDB中使用find()查找多个单词

我正在将Python与MongoDB结合使用。 我有一个单词数组,我使用这些单词搜索Mongo数据库,并使用$in匹配任何匹配字段的文档,例如 以上工作非常好,但我希望能够使用正则表达式。 现在的问题是,如果数组中的一个单词拼写为accus而不是accuse ,我希望find()查询 ...

10 VBA(Excel)中的查找函数找不到最小值

我一直在尝试这个很多次,但我没有得到这个工作。 我想要实现的目标:找到特定列 F:F 中的最小值,然后获取该值所在的行号(或范围地址)。 注意:变量rngMinimumVariableEins必须重新格式化,因为该值非常小。 ...

2018-12-11 13:00:27 2 74   excel/ vba
暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2022 STACKOOM.COM