マイクロソフトのワードで、複数の単語を連続して置換する方法を探しています。


例えば、テキストorCSVorワードなどのデータで20語ほどの置換したい単語のリストがあります。(例:規格→企画、取り扱い→取扱い、、、などなど)
これを、連続して一気に置換したいのです。
マクロ又はアドインのようなものはないでしょうか?
できれば、編集履歴又はコメントを付けられれば申し分ないのですが・・・。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2005/12/01 10:36:58
  • 終了:--

回答(4件)

id:Yuny No.1

ねがい かなみ回答回数953ベストアンサー獲得回数132005/12/01 12:01:16

ポイント10pt

http://www.vector.co.jp/soft/win95/writing/se167742.html

換の玉 Free for Word(Windows95/98/Me / 文書作成)

Wordのマクロですがこちらをおためしください。

id:isogava

ありがとうございます。かなり使えそうです。

2005/12/01 15:00:49
id:cooper0524 No.2

cooper0524回答回数296ベストアンサー獲得回数42005/12/01 12:10:59

ポイント20pt

とりあえず、今2,3分で作ったマクロなので拡張性は少ないですが、これでできます。


Sub Test()

Dim i As Integer

Dim A$(1)

Dim B$(1)

A$(0) = ”企画”: B$(0) = ”規格”

A$(1) = ”取り扱い”: B$(1) = ”取扱い”

For i = 0 To 1

Cells.Replace What:=A$(i), Replacement:=B$(i)

Next

End Sub

id:isogava

ありがとうございます!実は自作マクロで作ってみたかったので大助かりです!

2005/12/01 15:01:52
id:akibare No.3

akibare回答回数157ベストアンサー獲得回数52005/12/01 14:51:38

ポイント30pt

以前同じようなツールをWordのVBAで書きました。置換リストをテーブルに書いたWordを用意します(ただし1行目はヘッダーとする)。この文書から以下のスクリプトを実行する。


ちょっと解読が面倒かもしれませんが、ReplaceDという関数で実際の置換を行っています。各セクションのContentsとHeaderとFooterを対象にそれぞれ実行しなければならなかったと記憶しています。


あと、下記のスクリプトでは、ツールのWordファイルを置いたディレクトリにあるすべてのDOCファイルに対して同じ処理をするというものです。適当に加工してください。


置換を実行する前に編集履歴をONにすることも簡単だと思います。


’ Global variables

Dim fs As New FileSystemObject

Dim before(100) As String

Dim after(100) As String


’ The main replace tool entry point

Sub ReplaceA()

Dim doc As Document

Dim tbl As Table

’ Get active document, which is this tool

Set doc = ActiveDocument

Set tbl = doc.Tables(1)

’ Get the ”before” and ”after” replacment text sets

For i = 2 To tbl.Rows.Count

text1$ = tbl.Cell(i, 1).Range.Text

text2$ = tbl.Cell(i, 2).Range.Text

If (Len(text1$) > 2 And Len(text2$) > 2) Then

before(i - 2) = Left(text1$, Len(text1$) - 2)

after(i - 2) = Left(text2$, Len(text2$) - 2)

End If

Next

Call ReplaceB(doc.Path)

End Sub


’ Helper sub #1

Sub ReplaceB(loc As String)

Dim fld As Folder

Dim sfld As Folder

Dim f As File

Set fld = fs.GetFolder(loc)

For Each f In fld.Files

If UCase(Right(f.Name, 3)) = ”DOC” And Not (f.Name = ActiveDocument.Name) And Not Left(f.Name, 1) = ”~” Then

Call ReplaceC(f.Path)

End If

Next

End Sub


’ Helper sub #2

Sub ReplaceC(fp As String)

Dim wdoc As Document

Dim r As Range

Dim bFound As Boolean

Dim sec As Section

Dim i As Integer

’ Open the target document

Set wdoc = Documents.Open(fp)

’ Use the replacement rules to replace all text pairs in the content, headers and footers

For i = 0 To UBound(before) - 1

If Not before(i) = ”” Then

Call ReplaceD(wdoc.Content, before(i), after(i))

For Each sec In wdoc.Sections

Call ReplaceD(sec.Headers(wdHeaderFooterFirstPage).Range, before(i), after(i))

Call ReplaceD(sec.Headers(wdHeaderFooterPrimary).Range, before(i), after(i))

Call ReplaceD(sec.Footers(wdHeaderFooterPrimary).Range, before(i), after(i))

Next

End If

Next

’ Save the document

wdoc.Save

wdoc.Close

End Sub


’ Helper sub #3

Sub ReplaceD(r As Range, src As String, tgt As String)

With r.Find

.Text = src

.ClearFormatting

.Replacement.Text = tgt

.Execute Replace:=wdReplaceAll, Forward:=True, MatchCase:=True

End With

End Sub


’ Button function

Private Sub CommandButton1_Click()

Call ReplaceA

End Sub

id:isogava

ありがとうございます!!ここまでくれば、なんとか自作できそうです。やってみます。

2005/12/01 15:05:20
id:numak No.4

numak回答回数1941ベストアンサー獲得回数62005/12/01 22:12:04

ポイント10pt

シェアウェアですが、試用期間が

ありますので、試されてみては

いかがでしょうか?

id:isogava

ありがとうございます。いろいろツールがあるんですね。

自分でカスタマイズしたり機能を追加するために、簡単なVBかマクロで工夫してみることにしました。

2005/12/02 16:34:47

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません