1

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

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

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

虽然大多数代码都在工作，但限制是 --> 如果要找到两个单词，例如 1. Gold 2. Golden，然后将“gold”替换为“metal”，将 gold 替换为“矿物”，这就是发生的情况。如果代码在任何地方找到Golden，然后首先替换gold这个词，最终产品看起来像这样。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
4

1 回答 1

0

我没有添加评论的权限，所以我只能回答：

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

虽然我回答晚了，但它可能会帮助有类似问题的人......

于 2013-06-15T13:59:22.540 回答