[Word VBA]如何用find\replace做大量不同字串的取代? - 返回 最初的純真性情 - udn部落格
返回 最初的純真性情
作家:ThisIsTheWay
文章分類
    Top
    [Word VBA]如何用find\replace做大量不同字串的取代?
    2009/03/11 00:02:39
    瀏覽:23570
    迴響:14
    推薦:3
    引用0
    有位朋友說他需要把一些 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 實際的內容如下:



    這個檔案是MassReplace()執行字串取代之用
    一章,1章
    二章,2章
    三章,3章
    四章,4章
    五章,5章
    六章,6章
    七章,7章
    八章,8章
    九章,9章
    一款,1款
    二款,2款
    三款,3款
    四款,4款
    五款,5款
    六款,6款
    七款,7款
    八款,8款
    九款,9款
    第十章,第10章
    第二十章,第20章
    第三十章,第30章
    第四十章,第40章
    第五十章,第50章
    第六十章,第60章
    第七十章,第70章
    第八十章,第80章
    第九十章,第90章
    第一百章,第100章
    第一百一十章,第110章
    第一百二十章,第120章
    第一百三十章,第130章
    第一百四十章,第140章
    第一百五十章,第150章
    第一百六十章,第160章
    第一百七十章,第170章
    第一百八十章,第180章
    第一百九十章,第190章
    第十款,第10款
    第二十款,第20款
    第三十款,第30款
    第四十款,第40款
    第五十款,第50款
    第六十款,第60款
    第七十款,第70款
    第八十款,第80款
    第九十款,第90款
    第一百款,第100款
    第一百一十款,第110款
    第一百二十款,第120款
    第一百三十款,第130款
    第一百四十款,第140款
    第一百五十款,第150款
    第一百六十款,第160款
    第一百七十款,第170款
    第一百八十款,第180款
    第一百九十款,第190款
    第十,第1
    第二十,第2
    第三十,第3
    第四十,第4
    第五十,第5
    第六十,第6
    第七十,第7
    第八十,第8
    第九十,第9
    第一百零,第10
    第一百一十,第11
    第一百二十,第12
    第一百三十,第13
    第一百四十,第14
    第一百五十,第15
    第一百六十,第16
    第一百七十,第17
    第一百八十,第18
    第一百九十,第19


    之所以把 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

    回應
    迴響(14) :
    14樓. Nakki
    2023/07/21 04:17
    請問若想讓搜尋取代的範圍也包含頁尾的註釋,應該要怎麼修改呢?謝謝您
    13樓. KC
    2017/01/03 11:47
    這個故事完全體現了REGEX的重要性
    12樓. papa
    2016/01/16 03:35

    您好:

    我試了以後,他說        Call ReplaceText(arrStr(0), arrStr(1)) 這行有錯耶,不知道該怎麼改?

    (choupapa1025@gmail.com)
    11樓. 瑤瑤
    2014/01/18 09:50

    問題請教

    我有一文字要取代,例如我的文件中有ASTM D123及H20,我想將一此化學式如H20取代為H20[其中2改為下標],純以文字檔無法滿足這個要求,不知是否能將TXT檔改為WORD檔!

    (kuulbms@hotmail.com)
    10樓. Slayer
    2012/07/20 12:33

    po完後半節消失了

    Line Input #Fn, InputStr 是一次從檔案讀出一列嗎?

    我需要取代完一個字串, 先檢視是否ok後,再進行下一個字串取代

    但是試了半天都只能一次全部取代完,請問是否有辦法作到?!

    感謝您~

    (ad.lin701@gmail.com)
    9樓. Slayer
    2012/07/20 12:03

    不好意思,在網路上搜尋到此篇文章,

    實際上Run過 對我幫助很大,感謝您~

    另外,想請教一下

    8樓. glen
    2010/05/12 03:15
    請問問題

    您好:

    我在網上搜到用巨集大量的修改多個Word檔的內容

    Sub 取代一大堆()
     Set fs = CreateObject("Scripting.FileSystemObject")
     Set fd = fs.GetFolder("D:\Temp") '取得資料夾
     For Each f In fd.Files
      If fs.GetExtensionName(f.Name) = "doc" Then '取得副檔名
       Documents.Open f.Path
       Set myRange = ActiveDocument.Content
       myRange.Find.Execute FindText:="aaa", ReplaceWith:="bbb", _
      Replace:=wdReplaceAll
      ActiveDocument.Close True
      End If
     Next
    End Sub

    這個巨集可否跟您上面的巨集結合

    就是在多個word檔中做大量不同字串的取代

    還有取得副檔名可否有doc和docx

    謝謝

    7樓. glen
    2010/05/12 02:42
    關於罕用字

    您好:可以用了,真的好方便,好快,很感謝!!

    我說的罕用字是中文ex:鞕,脇,髃,髎.............

    (因為滿多的一一修改還是很花時間)

    這些文字在記事本若以ANSI編碼儲存會變成?號

    若存成Unicode編碼就成正常顯示,但巨集就不能執行

    6樓. kiigu
    2009/12/08 17:07
    特定字更改顏色,但特定字數量極多
    您好,前面有人請教到特定字更改顏色的問題。
    我也有類似的問題,但最大的問題是需要更改的特定字有上千個,請問有什麼辦法嗎?
    5樓. bao
    2009/10/01 15:45
    特定字只改顏色

    您好,想請問您..如何就特定字改顏色??

    ex.

    特定字:你,我,他

    因文章有標示注音,如果文章中出現上述的特定字就改成紅字,但是特定字的注音還是要黑色的

    非常感謝您~~~

    前面不是有位朋有問題是要把 { } 裡的字改成紅色嗎?你就把程式裡的 {} 改成 "你",Run
    一遍看看,改成 "我" Run 一遍,改成 "他" Run 一遍,沒錯的話,把這樣的程式組合起來成一個程式就好啦!

    不知您的文章標示注音是如何標示的?你用手工去改字的顏色看看,能夠把字改成紅色,而注音仍是黑色嗎?
    如果手工做不到,程式也就做不到。如果手工做得到,就用錄製巨集錄下來,看指令是怎樣做的。
    ThisIsTheWay2009/10/03 14:30回覆
    發表迴響

    會員登入