vba - VBA Excel ルックアップ

Question

Excel で VBA を使用して正確な一致を見つける方法を教えてください。これが私のオブジェクト7の問題です。

目的 - 単語の検索と置換をバッチ処理する。

これは、私が自動化しようとしているルーチン タスクです。このタスクには、用語を見つけて、それらを別の単語に置き換えることが含まれます。たとえば、見つかった用語が「microsoft」の場合、「Company」と置き換えたいとします。

コードの大部分は機能していますが、制限は次のとおりです --> 2 つの単語が見つかった場合、たとえば 1. ゴールド 2. ゴールデンの場合、「ゴールド」を「メタル」に、ゴールデンを「ミネラル」に置き換えます。どこでも 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