他說曾想過用 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
您好:
我試了以後,他說 Call ReplaceText(arrStr(0), arrStr(1)) 這行有錯耶,不知道該怎麼改?
(choupapa1025@gmail.com)問題請教
我有一文字要取代,例如我的文件中有ASTM D123及H20,我想將一此化學式如H20取代為H20[其中2改為下標],純以文字檔無法滿足這個要求,不知是否能將TXT檔改為WORD檔!
(kuulbms@hotmail.com)po完後半節消失了
Line Input #Fn, InputStr 是一次從檔案讀出一列嗎?
我需要取代完一個字串, 先檢視是否ok後,再進行下一個字串取代
但是試了半天都只能一次全部取代完,請問是否有辦法作到?!
感謝您~
(ad.lin701@gmail.com)不好意思,在網路上搜尋到此篇文章,
實際上Run過 對我幫助很大,感謝您~
另外,想請教一下
您好:
我在網上搜到用巨集大量的修改多個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
謝謝
您好:可以用了,真的好方便,好快,很感謝!!
我說的罕用字是中文ex:鞕,脇,髃,髎.............
(因為滿多的一一修改還是很花時間)
這些文字在記事本若以ANSI編碼儲存會變成?號
若存成Unicode編碼就成正常顯示,但巨集就不能執行
您好,想請問您..如何就特定字改顏色??
ex.
特定字:你,我,他
因文章有標示注音,如果文章中出現上述的特定字就改成紅字,但是特定字的注音還是要黑色的
非常感謝您~~~