Question

我正在努力替换文本文件中的一串文本。文本字符串可以出现在文本文件中的多个位置。问题是我需要替换的字符串末尾有一个字母，可能是任何字母。我试过用“？”代替“X”（见下面的代码），但由于宏继续失败，我的实现必须是不正确的。我试过了？，“？”，[？]和（[？]）都无济于事。也许有更好的方法来完成这项任务。这是我一直在做的......

    'Set variable
    Dim TempFile As String
    TempFile = "C:\VBAtemp\Temp.txt"

    'File Path of Text File
    FilePath = TempFile

    'Determine the next file number available for use by the FileOpen function
    TextFile = FreeFile

    'Open the text file in a Read State
    Open FilePath For Input As TextFile

    'Store file content inside a variable
    FileContent = Input(LOF(TextFile), TextFile)

    'Clost Text File
    Close TextFile

    'Find/Replace
    'PROBLEM: "X" CAN BE ANY LETTER (A-Z). 
    FileContent = Replace(FileContent, "This is your letter: X", "This is your letter: A")

    'Determine the next file number available for use by the FileOpen function
    TextFile = FreeFile

    'Open the text file in a Write State
    Open FilePath For Output As TextFile

    'Write New Text data to file
    Print #TextFile, FileContent

    'Close Text File
    Close TextFile

Answer 1

尝试这两个版本 - 在使用108 MB文件进行光测试后：

ReplaceTxt1() - Replaced: 7;         Time: 14.333 sec
ReplaceTxt2() - Replaced: 5,000,011; Time: 71.305 sec

测试文件内容：

This is your letter: xThis is your letter: YThis is your letter: zThis is your letter: x
This is your letter: AThis is your letter: mThis is your letter: q This is your letter: s 
This is your letter: A  This is your letter: v
... (repeated n times)

测试结果（两个版本）：

This is your letter: AThis is your letter: AThis is your letter: AThis is your letter: A
This is your letter: AThis is your letter: AThis is your letter: A This is your letter: A 
This is your letter: A  This is your letter: A
... (repeated n times)

<强> ReplaceTxt1

Public Sub ReplaceTxt1()
    Const FIND_TEXT = "This is your letter: "   'string identifying letter to be replaced
    Const FULL_PATH = "C:\VBAtemp\Temp.txt"

    Dim fileNum As String, fileTxt As String, found As Long, findLen As Long
    Dim ltr As String, done As String

    fileNum = FreeFile  'Next file number available for use by the FileOpen function
    Open FULL_PATH For Input As fileNum     'Open the text file in a Read Mode
    fileTxt = Input(LOF(fileNum), fileNum)  'Store file content inside a variable
    Close fileNum       'Clost Text File

    findLen = Len(FIND_TEXT)            'number of characters in "This is your letter: "
    found = InStr(fileTxt, FIND_TEXT)   'search for the first "This is your letter: "
    If found > 0 Then                   'if one was found continue (else exit)
        Do  'start looping
            ltr = Mid$(fileTxt, found + findLen, 1) 'get leter - 1 char, after identifier
            If InStrB(done, ltr) > 0 Then Exit Do   'done is a collection of letters id'd
            While ltr = "A"     'if the next found letter is "A" skip it
                found = InStr(found + findLen + 1, fileTxt, FIND_TEXT)  'find the letter
                ltr = Mid$(fileTxt, found + findLen, 1)                 'extract it
                If found = 0 Then Exit Do  'if FIND_TEXT is not found we are done so exit
            Wend    'repeat the search
            fileTxt = Replace$(fileTxt, FIND_TEXT & ltr, FIND_TEXT & "A") 'Use Replace$
            done = done & ltr   'append the letter we just replaced to the done string
            found = InStr(found + findLen + 1, fileTxt, FIND_TEXT)  'find next FIND_TEXT
        Loop Until found = 0    'if the last attempt to find FIND_TEXT, we are also done

        fileNum = FreeFile
        Open FULL_PATH For Output As fileNum    'Open the text file in Write Mode
        Print #fileNum, fileTxt 'Write New Text data to file
        Close fileNum           'Close Text File
    End If
End Sub

<强> ReplaceTxt2

Option Explicit

Public Sub ReplaceTxt2()
    Const FIND_TEXT = "This is your letter: "   'string identifying letter to be replaced
    Const FULL_PATH = "C:\VBAtemp\Temp.txt"

    Dim fileNum As String, fileTxt As String, x As Variant, i As Long

    fileNum = FreeFile  'Next file number available for use by the FileOpen function
    Open FULL_PATH For Input As fileNum     'Open the text file in a Read Mode
    fileTxt = Input(LOF(fileNum), fileNum)  'Store file content inside a variable
    Close fileNum       'Clost Text File

    x = Split(fileTxt, FIND_TEXT) 'Split the string by "This is your letter: "

    If UBound(x) > 0 Then         'if at least 1 instance found, array UBound=1 (or more)
        For i = 0 To UBound(x)    'iterate array (for may test file array, see img bellow)
          If Len(x(i)) > 0 Then   'we don't want to process empty vals/strings (Lenght 0)
             x(i) = "A" & Right$(x(i), Len(x(i)) - 1) 'add "A" to the itm minus 1st char
          End If
        Next    'repeat to the end of the array

        fileTxt = Join(x, FIND_TEXT)  'join the string by inserting FIND_TEXT back

        fileNum = FreeFile
        Open FULL_PATH For Output As fileNum    'Open the text file in Write Mode
        Print #fileNum, fileTxt 'Write New Text data to file
        Close fileNum           'Close Text File
    End If
End Sub

由x

提取的变体数组x = Split(fileTxt, FIND_TEXT)（基于0）

我应该使用哪些VBA代码来搜索和替换文本文件中的文本，这些文本在每次出现时可能会有所不同？

1 个答案: