Question

我需要帮助才能在Excel中使用VBA查找完全匹配。这是我的对象7问题。

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

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

虽然大多数代码都在运行，但限制是 - ＆gt;如果有两个单词可以找到，例如1.黄金2.黄金然后用“金属”代替“黄金”，用“矿物质”代替黄金。如果代码在任何地方找到Golden，那么黄金首先被替换，最终产品看起来像这样.Metalen。可以有人请帮忙吗？

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匹配以黄金开头的字词和\bgold\b以完全匹配黄金。

虽然我迟到了，但它可能对有类似问题的人有帮助......

VBA Excel查找

1 个答案: