網路城邦
上一篇 回創作列表 下一篇   字體:
[Word VBA]如何用find\replace做大量不同字串的取代?
2009/03/11 00:02:39瀏覽23578|回應14|推薦3

有位朋友說他需要把一些 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

( 興趣嗜好電腦3C )
回應 推薦文章 列印 加入我的文摘
上一篇 回創作列表 下一篇

引用
引用網址:https://classic-blog.udn.com/article/trackback.jsp?uid=WayCheng&aid=2731101

 回應文章 頁/共 2 頁  回應文章第一頁 回應文章上一頁 回應文章下一頁 回應文章最後一頁

Gary
謝謝大大
2009/06/02 10:43

謝謝~~真的可以用了~~~

ThisIsTheWay(WayCheng) 於 2009-07-04 13:45 回覆:
免客氣!歡迎再來!

Gary
請教問題
2009/06/02 02:26

您好~~~

想請教一個問題

我想取代 {h  ...   h}   所包住的文字變成紅色 

例如 : {haaah}  , {hbbh} , {hch}

中間字元數量不一定

請問可以用一個取代指令做出來嗎?

還是要每個長度都要取代一次呢?

ThisIsTheWay(WayCheng) 於 2009-06-02 07:46 回覆:
基本上,你可以在 Word 裡做一次,用錄製巨集把動作錄下來,就知道巨集的寫法了。不幸的是,錄製下來的巨集會有些短少,這個例子裡短少的就是 color 的那一列程式:

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find .Text = "\{h*h\}"
    .Replacement.Text = ""
    .Replacement.Font.Color = wdColorRed
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

glen
問題請教
2009/05/01 14:49

您好:

我將版上的程式複製,貼到Normal,執行巨集後出現:

執行階段錯誤’9’:

陣列索引超出範圍

 

還有要取代的字串只能存成純文字檔嗎?

我要取代的字串有罕用字, 純文字檔無法顯示

ThisIsTheWay(WayCheng) 於 2009-05-07 20:40 回覆:
抱歉,程式有錯,現在已更正了,請重新複製。

您說的 "罕用字" 是中文還是其他語文?為何純文字檔無法顯示?

lukfa
macro
2009/05/01 00:19
拜讀大作之後, 本人感到非常實用, 希望能應用在實際工作中, 可惜囿於對電腦的認識有限, 所以懇切請求您可否詳細作一個說明, 例如如何在巨集編輯器裡面定義sub(本人輸入程式碼後無法執行, 它經常出現須定義sub或function的訊息.
閣下如能詳鈿解釋, 本人感激不盡.

此致

安康

陸俊發
Email: lukfa68@yahoo.com
ThisIsTheWay(WayCheng) 於 2009-05-07 20:15 回覆:
所謂定義 Sub (副程式) 或 Function(函數) 就是像這樣寫:

Sub ABC(參數宣告)

     副程式 ABC 的程式碼寫在這裡

End Sub

Function WXY(參數宣告) As 傳回值型別

   函數 WXY 的程式碼寫在這裡

End Function

出現你說的那種訊息,往往是因你在程式裡面呼叫副程式或函數,但你把它的名稱打錯了,或者你打了一個 VB 不認識的字。

建議你買本 VB 或 VBA 的書從頭開始詳細的閱讀,VBA 的 Help 裡也有語言參考可查。
頁/共 2 頁  回應文章第一頁 回應文章上一頁 回應文章下一頁 回應文章最後一頁