office [ word excel ] 用vba 大量取代

有位朋友說他需要把一些 Word 文件檔裡面的 "第一章" 全部改成  "第1章"、 "第一款" 全部改成  "第1款"、......依此類推，最多會到第一百多章、第一百多款 
給他放在 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 功能執行取代。
而在使用者要執行的 MassReplace() 副程式裡，是由 Replace.txt 每讀出一列，就把 "要被取代" 和 "要用來取代" 的字串傳給 ReplaceText() 函式去執行。
Replace.txt 的每一列裡面以逗號 (左右不要空格) 來分隔要尋找的字串與要用來取代的字串。第一格若是 ' 表示這一列是註解，程式會把這一列略過。
文件檔裡面有第一章～第一百九十九章、第一款～第一百九十九款需要做取代，所以扣除註解，Replace.txt 會有 199x2 = 398 列對嗎？


被取代   取代
' 這個檔案是MassReplace()執行字串取代之用
Replace.txt 實際的內容如下:
__________________________-
一章,1章
二章,2章
三章,3章
四章,4章
__________________________-
之所以把 Replace.txt 的內容全部列出來，是因為我用了一點小技巧安排這個檔案的內容 (尤其是先後的順序)

excel
如果在 Excel 裡有大量不同的字串要取代，可以用底下的方法：
Step 1)
在 Windows 記事本或 WordPad 裡輸入 "要被取代的字串,要用來取代的字串"，例如要把"2330"取代成"台積電"，要把"2337"取代成"旺宏"，就輸入：
2330,台積電
2337,旺宏
像這樣每一組一行。記事本可編輯的資料大小受限在 64KB，如果資料非常多，建議使用 WordPad。
Step 2)
把輸入好的資料存入 C:\ 命名為 Replace.txt
Step 3)
開啟要做取代的活頁簿，按 Alt+F11 進入 VBA 編輯環境，插入一個模組，複製底下的程式碼，貼入模組裡面。

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 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 字串
Cells.Replace What:=Src, Replacement:=Rpl, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'底下是 Replace 的參數說明：
'What 必選的參數。要尋找的字串。
'Replacement 必選的參數。要置換的字串。
'LookAt 選擇性的參數。是否需全字相同。可為下列 XlLookAt 常數之一：xlWhole 或 xlPart。
'SearchOrder 選擇性的參數。搜尋的順序。可為下列 XlSearchOrder 常數之一：xlByRows 或 xlByColumns。
'MatchCase 選擇性的參數。若指定為 True，則搜尋時大小寫視為相異。
'SearchFormat 選擇性的參數。是否依據 "格式" 搜尋。True/False布林值。
'ReplaceFormat 選擇性的參數。是否取代格式。True/False布林值。
End Function

Step 4)
回到 Excel 工作表視窗，切換到要做取代的工作表，然後按 Alt+F8，選擇 MassReplace 這個巨集按「執行」令它執行。
註:
1. "C:\Replace.txt" 可以依所需修改成你想存放的磁碟目錄及檔名。
2. 因為程式裡用 Cells.Replace 是沒有指定工作表，就是針對 Active 的工作表，而沒有指定 Cell 的 Row, Column，所以是針對整張工作表所有的儲存格做取代。