VBA Excel查找

Question

我需要在Excel中使用VBA查找精确匹配的帮助。 这是我的目标7问题。

目标-批量处理查找和替换单词。

这是我要自动化的例行任务。 该任务涉及查找术语，然后用替代词替换它们。 例如，如果要找到的术语是“ microsoft”，我希望将其替换为“ Company”。

虽然大多数代码都起作用，但限制是->如果找到两个单词，例如1.金2.金，然后用“金属”替换“金”，用“矿物”替换“金”，这就是发生的情况。在任何地方找到“金”，然后首先替换“金”一词，最终产品看起来像这样。

Dim wksheet As Worksheet
Dim wkbook As Workbook
Dim fo_filesys As New Scripting.FileSystemObject
Dim RegExpObject As Object

Private Sub cmd_Start_Click()
    Dim lsz_dest_path As String
    Dim lsz_extn_to_use As String
    Dim lsz_filename As String

    Dim li_rowtoread As Integer

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    lsz_dest_path = VBA.Strings.Trim(Cells(1, 6))
    lsz_extn_to_use = VBA.Strings.Trim(Cells(2, 6))

    Set RegExpObject = CreateObject("VBScript.RegExp")

    RegExpObject.IgnoreCase = True
    RegExpObject.Global = True

    lsz_filename = Dir(lsz_dest_path & "\" & lsz_extn_to_use)
    Do While lsz_filename <> ""
        Application.StatusBar = "Scrubbing " & lsz_filename
        Set wkbook = Workbooks.Open(lsz_dest_path & "\" & lsz_filename)
        For Each wksheet In wkbook.Worksheets
            wksheet.Activate
            li_rowtoread = 2
            Do While Cells(li_rowtoread, 1) <> ""
                user_process_file Cells(li_rowtoread, 1), Cells(li_rowtoread, 2), lsz_filename
                li_rowtoread = li_rowtoread + 1
                DoEvents
            Loop
        Next wksheet
        wkbook.Close True
        lsz_filename = Dir
    Loop
    Application.StatusBar = ""
End Sub

Sub user_process_file(lsz_searh_str As String, lsz_replace_str As String, filename As String)
    Dim myRange As Range
    Dim lo_tstream As TextStream
    Dim lo_reader_tstream As TextStream
    Dim lsz_file As String
    Dim lb_replaced As Boolean

    If fo_filesys.FileExists(filename & ".log") Then
        Set lo_reader_tstream = fo_filesys.OpenTextFile(filename & ".log", ForReading)
        lsz_file = lo_reader_tstream.ReadAll
        lo_reader_tstream.Close
    End If
    If lsz_searh_str = "RRD" Then
    '    MsgBox "Here"
    End If
    Set myRange = wksheet.Cells

    myRange.Cells.Find(What:="", After:=ActiveCell, lookat:=xlPart).Activate
    'myRange.Replace What:=lsz_searh_str, Replacement:=lsz_replace_str, LookAt:=xlWorkbook, MatchCase:=False, searchorder:=xlByRows ', LookIn:=xlFormulas

    With myRange
    Set c = .Find(lsz_searh_str, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
                c.Value = CustomReplace(c.Value, lsz_searh_str, lsz_replace_str)

            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With

    Set lo_tstream = fo_filesys.OpenTextFile(filename & ".log", ForAppending, True)
    lb_replaced = myRange.Replace(What:=lsz_searh_str, Replacement:=lsz_replace_str, lookat:=xlWhole, MatchCase:=True, searchorder:=xlByRows)


    If lb_replaced = True Then
        lo_tstream.WriteLine lsz_replace_str
        lo_tstream.Close
    End If

End Sub

Function user_eval(lookfor As String, loc_data As String) As Boolean
    Dim lsz_val_at_loc As String

    If InStr(1, loc_data, lookfor) = 1 Then
        user_eval = True
    Else
        user_eval = False
    End If

End Function

Function CustomReplace(OriginalString As String, FindString As String, ReplaceString As String)

    RegExpObject.Pattern = "[^a-zA-Z0-9]*" & FindString & "[^a-zA-Z0-9]*"
    CustomReplace = RegExpObject.Replace(OriginalString, ReplaceString)

End Function

Answer 1

我没有添加评论的权限，因此只能回答以下问题：

您的正则表达式查找字符串[^a-zA-Z0-9]*和[^a-zA-Z0-9]* 。 尝试使用\\bgold\\w+\\b匹配以gold开头的单词，并使用\\bgold\\b精确匹配gold。

尽管我迟到了，但它可能会帮助遇到类似问题的人...