有位朋友說他需要把一些 Word 文件檔裡面的 "第一章" 全部改成  "第1章"、 "第一款" 全部改成  "第1款"、......依此類推，最多會到第一百多章、第一百多款 (我猜想可能是討論法規的文章吧！)

他說曾想過用 Word 的搜尋\取代，但是因為文章裡會有一些其他的中文數字，例如 "十分完備" 之類的，所以不可以直接用 "1～199" 取代 "一～一百九十九"。所以需用 "第1章"～"第199章" 取代 "第一章"～"第一百九十九章"。可是手動操作真會累死，檔案還不只一個......(好像愚公移山 ^_^ )

於是我寫了底下的程式，給他放在 Normal.dot  (的插入模組) 裡使用：

Option Base 0

Sub MassReplace()
Dim arrStr() As String, InputStr As String

Fn = FreeFile

Open "C:\Replace.txt" For Input As #Fn 開啟 Replace.txt 檔
Application.ScreenUpdating = False  畫面暫停更新
While Not EOF(Fn) 
    Line Input #Fn, InputStr 從檔案讀出一列,
    If Len(InputStr) > 0 And Mid(InputStr, 1, 1) <> "" Then 若第一個字元是就跳過此列
        arrStr = Split(InputStr, ",")  把讀入的文字列依逗號分成兩個字串,
                                                 置於 arrStr 陣列裡
        Call ReplaceText(arrStr(0), arrStr(1))
    End If
Wend
Application.ScreenUpdating = True  畫面恢復更新
Close #Fn

End Sub

Function ReplaceText(Src As String, Rpl As String)
這個函式會在整個檔案裡搜尋 Src 字串, 將它取代為 Rpl 字串

Selection.HomeKey Unit:=wdStory, Extend:=wdMove
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = Src
    .Replacement.Text = Rpl
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = True
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    .Execute Replace:=wdReplaceAll  全部取代
End With

End Function

原理是用Windows記事本 (Notepad) 把 "要被取代" 和 "要用來取代" 的字串寫在 Replace.txt 純文字檔案 (放在 C: 磁碟的根目錄) 裡，寫一個 ReplaceText() 函式去呼叫 Word 的 find 功能執行取代。

(2023/1/27補充：Replace.txt 純文字檔案若使用 UTF-8 或 unicode 字元集儲存，則使用 Line Input 無法正常逐列讀入，需改用 ADODB.STREAM，我在文末補充，請參閱) 

而在使用者要執行的 MassReplace() 副程式裡，是由 Replace.txt 每讀出一列，就把 "要被取代" 和 "要用來取代" 的字串傳給 ReplaceText() 函式去執行。

Replace.txt 的每一列裡面以逗號 (左右不要空格) 來分隔要尋找的字串與要用來取代的字串。第一格若是 表示這一列是註解，程式會把這一列略過。

文件檔裡面有第一章～第一百九十九章、第一款～第一百九十九款需要做取代，所以扣除註解，Replace.txt 會有 199x2 = 398 列對嗎？

Replace.txt 實際的內容如下:

之所以把 Replace.txt 的內容全部列出來，是因為我用了一點小技巧安排這個檔案的內容 (尤其是先後的順序)，所以只用了75列 (也就是要執行75次find\Relpace)，就可以解決第一章～第一百九十九章、第一款～第一百九十九款的取代。

不信你就試試吧！

※2023/1/27補充：Replace.txt 若是 UTF-8 或 UNICODE 文字檔，則 MassReplace() 程式碼改寫如下：

Sub MassReplace()

Dim arrStr() As String, InputStr As String, objStream As Object

Application.ScreenUpdating = False  畫面暫停更新

Const adReadLine = -2    讀取一列

Const adTypeBinary = 1   二進位型 adTypeBinary = 1, 文字型 adTypeText =2

Const adTypeText = 2

Set objStream = CreateObject("ADODB.Stream")   建立文字檔串流物件

With objStream

    .Charset = "UTF-8"                         TEXT 檔是用記事本儲存成 UTF-8 字元集的檔案

    .Type = adTypeText

    .Open

    .LoadFromFile "D:\VBA\Replace-utf8.TXT"    開啟並讀入 Replace.txt 檔,

                                                                     需指定檔案路徑

    Do Until .EOS

        InputStr = .ReadText(adReadLine)       讀取一列文字

        arrStr = Split(InputStr, ",")          把讀入的文字列依逗號分成兩個字串,

                                                               置於 arrStr 陣列裡

        Call ReplaceText(arrStr(0), arrStr(1))  呼叫 ReplaceText()

    Loop

    .Close 關閉 adodb stream

End With

Application.ScreenUpdating = True  畫面恢復更新

End Sub