No.6ベストアンサー
- 回答日時:
#3で回答した者です。
語数にもよりますが、春、夏、秋、冬をひとつずつ検索の表に入れておけば変わります。
語数が多ければ下のマクロを試してください。検索する表に「春夏秋冬」とあっても、「春」「夏」「秋」「冬」をひとつずつ検索してフォントを変えていくように変更しました。
Sub ReplaceFontColor()
Dim rngFind As Range
Dim row As row
Dim rowReplace As Rows
Dim MyLen As Integer
winNo = Windows.Count
With Selection
Set rowReplace = Windows(winNo).Document.Tables(1).Rows
For Each row In rowReplace
Set rngFind = row.Cells(1).Range
rngFind.MoveEnd Unit:=wdCharacter, Count:=-1
MyLen = Len(rngFind)
For j = 1 To MyLen
SingleLetter = Mid(rngFind, j, 1)
With Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Text = SingleLetter
.MatchByte = True
.MatchCase = True
.MatchWholeWord = True
.Replacement.Font.ColorIndex = wdRed
.Execute Replace:=wdReplaceAll
End With
Next
Next
End With
End Sub
有難うございます。おっしゃるとおり上手くいきました。何度も質問に丁寧に答えていただき感謝感激です。本当に有難うございました。
次は、1000字以上の置換を実際にやってみたいと思います。
No.5
- 回答日時:
#3で回答した者です。
こちらの書き方が悪くて、すみません。
置換したい文書を先に開いておき、さらに別ファイル(新規文書でも可)を開き、そこに一列の表を描き、セルの中に検索元の文字を入力して下さい。
つまり、文書1(先に開いておくファイル)はフォントを変えたい文書を、文書2(後で開くファイル)はフォントを変えたい文字の一覧になります。これでやってみてください。
また何かありましたら、遠慮なく質問してください。
この回答への補足
とんでもございません。理解力不足で申し訳ないです。
「文書2」にたとえば(春夏秋冬)と記入し、「文書1」にちりばめられた(春夏秋冬)は赤くなったのですが、(春)(夏)(秋)(冬)と1文字ずつちりばめた単語には変化がないのです。
つまり、1単語or1熟語のみを一度に変換したいのではなく、1000種類の個別の漢字を元に1000種類の漢字が別々にちりばめられた文章の中から検索し一字ずつ赤に変換したいのです。
物分りが悪いのかもしれませんがよろしくお願いいたします。
No.4
- 回答日時:
こんにちは。
いまどきは、「第一次水準漢字」とかいう区分けは、Wordにはないので、一旦、文字コードを換えてあげないと出来ませんね。それと、Wordの能力一杯一杯です。Wordは、意外に、マクロのパワーがないような気がします。
また、外字の区分けは、Wordにはありませんから、特別の文字コードを検索するようになります。こちらでは、外字領域に、ハングルが現れてきています。
'Option Explicit
Public Const MYCOLOR As Long = wdColorRed '色-赤
Sub JISCodeLettersSearch()
'JIS検索プログラム
'JIS第一水準漢字を探すマクロ
Dim mySelection As Selection
Dim TowByte() As String
Dim j As Long
Dim i As Long
Dim ltr As String
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Set mySelection = Selection
For i = 1 To Len(mySelection)
ltr = Mid$(mySelection, i, 1)
If Asc(ltr) >= &H889F And Asc(ltr) <= &H9872 Then
ReDim Preserve TowByte(j)
TowByte(j) = ltr
j = j + 1
End If
Next i
If j = 0 Then MsgBox "単語は見つかりません。", vbInformation: Exit Sub
Application.ScreenUpdating = False
For j = 0 To UBound(TowByte)
WordHilightPrc TowByte(j)
Next
Application.ScreenUpdating = True
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.HomeKey Unit:=wdStory
End Sub
Sub WordHilightPrc(ByVal myStr As String)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = myStr
.Replacement.Text = myStr
.Replacement.Font.Color = MYCOLOR
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
'Unicode 検索
"[\u3041-\u3094]+" 'ひらがな
"[\ue000-\ue757]+" '外字
Option Explicit
Sub TwoByteStrFindProc()
'Unicode検索プログラム
'要設定:参照設定 Microsoft VBScript Regular Expressions
Dim objRegExp As New RegExp
Dim mySelection As Selection
Dim Matches As Object
Dim Match
Dim TowByte()
Dim sLength As Long
Dim i As Long
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Set mySelection = Selection
With objRegExp
.Global = True
.IgnoreCase = True
.Pattern = "[\u3041-\u3094]+" 'ひらがな検索
Set Matches = .Execute(mySelection)
sLength = 0
End With
For Each Match In Matches
ReDim Preserve TowByte(i)
TowByte(i) = Match.Value
i = i + 1
Next Match
If Matches.Count = 0 Then MsgBox _
"該当する検索文字が見つかりません", 64: Exit Sub
Application.ScreenUpdating = False
For i = 0 To UBound(TowByte)
WordHilightPrc TowByte(i)
Next
Application.ScreenUpdating = True
Selection.HomeKey Unit:=wdStory
End Sub
有難うございました。今回の私の質問テーマとは直接すぐに役に立たなかったのですが、せっかく丁寧に回答していただきましたので、じっくり眺めて勉強してみたいと思います。本当に有難うございました。
No.3
- 回答日時:
回答があまりないようですが、以下のマクロを試してみてください。
マクロを実行するまえに別に新規のワードの文書に1列の表を作って、その表の中にフォントの色を変えたい文字を書き込んでおき、フォントを変えたい文書と同時に開いておく必要があります。
Sub ReplaceFontColor
Dim rngFind As Range
Dim row As row
Dim rowReplace As Rows
winNo = Windows.Count
With Selection
Set rowReplace = Windows(winNo).Document.Tables(1).Rows
For Each row In rowReplace
Set rngFind = row.Cells(1).Range
rngFind.MoveEnd Unit:=wdCharacter, Count:=-1
With Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Text = rngFind.Text
.MatchByte = True
.MatchCase = True
.MatchWholeWord = True
.Replacement.Font.ColorIndex = wdRed
.Execute Replace:=wdReplaceAll
End With
Next
End With
End Sub
この回答への補足
初心者なので、変な質問もお許しくださいね。
ワード「文書1」「文書2」と2つ開いておき、
「文書1」に一列の表を描きセルの中に検索元の複数の漢字を入力します。
「文書2」に赤色に変更したい文字を含んだより多数の一群の漢字を入力しておきます。
文書2のVBEにReplaceFontColor()コードをコピペします。
こうしてやってみたのですが、何の変化も起こりません。どこの操作が間違っているのでしょうか?
No.2
- 回答日時:
Wordの1語句(単語)の置換のVBAコード例は、WEB照会で、沢山出てきます。
#1でおっしゃっているように、「>千種類ほどの単語」とスラッというが、(1)どういう状態で存在するのか(例えばテキストファイルにあるのか)、(2)個別にその都度入力するのか(3)一遍に(1回の実行で)別々の1000単語の文字色を一斉に変えるのか、(4)必要の都度数語を置換し、別の機会に何度も行うのか(4)1000語に共通性があるのか(ワイルドカードを使って表されるような)
最悪1000回置換ルーチンを繰り返しか?
プログラムを組む人はそちらに興味(心配、課題、解決すべき問題点)があると思う、と思う。
すなわち、上記質問は不完全と思う。
この回答への補足
おっしゃるとおり不完全な質問で申し訳御座いません。
例えば 第一次水準漢字が記入されたファイルを基にして、第一次水準漢字・第二次水準漢字・外字・ひらかな・カタカナ等が1万字ほどランダムに混在するファイルの中から第一次水準漢字のみを選びその漢字をすべて一度にフォント色を赤に変えるにはどうすればよいのでしょうか?あるいは外字とひらかなが記入されたファイルを基に同じように第一次水準漢字・第二次水準漢字・外字・ひらかな・カタカナ等が1万字ほどランダムに混在するファイルの中から外字とひらかながのみを選びそれらをすべて一度にフォント色を赤に変えるにはどうすればよいのでしょうか?
No.1
- 回答日時:
Wordでの作業と仮定して…
> 特定の千種類ほどの単語を
1文字目がA
4文字目がD
とかなら、マクロを使わずとも1回の置換で可能な気もしますが…。
普通は、1つの単語に対する処理を千回ほど繰り返せば良いだけです。
苦労するのは、質問者さんでなくてPCなんですから…。
--
1回の処理を記録して、記録したSubのモジュールを引数指定できるよう修正し、予め準備してある単語を元に、Excelなんかで単語を引数にして単語数回分Callする処理を作成とか。
この回答への補足
質問内容が不完全でした。申し訳御座いません。
> 特定の千種類ほどの単語
具体的には千種類ほどの漢字を別ファイル(A)に記入してあります。
他方1万種類ほどの漢字が記入されたファイル(B)があります。
ファイル(B)の中からファイル(A)に有る漢字と一致した漢字をフォント色「黒」から「赤」に一度に変換したいのです。
>1回の処理を記録して、記録したSubのモジュールを引数指定できるよう修正し、予め準備してある単語を元に、Excelなんかで単語を引数にして単語数回分Callする処理を作成とか。
初心者なのでここのところがわかりません。
Sub フォントを赤に()
'
' フォントを赤に Macro
' 記録日 2007/01/25 記録者 xxxx
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "黒"
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
このマクロで「黒」という文字のフォント色を(赤)に変えることは出来たのですが、他のファイルに有る千種類の漢字をどう読み込むか分からないですし、修正した段階で上記のマクロがうまく作動するか自信ありません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Word(ワード) ワードフォント 一括置換の方法 4 2022/12/31 00:27
- Visual Basic(VBA) 特定の文字を簡単な操作で半角スペースに変換するか削除したい 2 2022/11/01 10:35
- 政治 私の発明した「二階建て漢字」は使えるでしょうか? 3 2023/02/08 16:40
- Word(ワード) ワードでフォントを選ぶとき、一覧からではなく検索等できないでしょうか? 2 2022/10/22 17:52
- フリーソフト テキストファイルの一括置換で除外したい文字があります。 2 2022/06/21 17:53
- その他(Microsoft Office) エクセルのマクロについて教えてください。 5 2023/01/21 09:39
- Word(ワード) Word2019と365の互換性について質問 1 2023/06/10 19:33
- Excel(エクセル) Excelで校閲をする方法はあるでしょうか(取扱説明書への掲載禁止用語の確認) 3 2022/06/11 22:51
- Word(ワード) ワードで,特定の文字だけ,字体を一括変換する方法は? 1 2023/04/26 10:11
- その他(パソコン・周辺機器) ワード 新規作成の時のフォント 2 2022/04/04 16:47
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
カンマを改行に変換する方法
-
1文字だけ置換したい
-
カンマ( , )をタブに置換したい。
-
Excelで全角ハイフンを半角ハイ...
-
エクセルで濁点カナの変換方法...
-
エクセルの『検索と置換ボック...
-
ワードで複数の文字を一括・連...
-
Excelで特定の文字以下を削除し...
-
ExcelのVBA 正規表現でタブを...
-
桐の項目名の変数利用(一括処理)
-
Wordで括弧を残し、その内側の...
-
サクラエディタで特定の改行を...
-
Excel : テキストボックス中の...
-
文字の列を揃えるには
-
ワード (word ) 日本語の文字...
-
【MS Office Word 2007】文章の...
-
エクセルで文字の置き換えって...
-
エクセルでコンマとピリオドを...
-
テキストでタブを検索してスペ...
-
Word:差し込み印刷時に文字列...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
カンマを改行に変換する方法
-
カンマ( , )をタブに置換したい。
-
秀丸で余分なスペースを削除したい
-
Excelで全角ハイフンを半角ハイ...
-
文字の列を揃えるには
-
エクセル重複削除で綺麗に削除...
-
複数のスペースを1つのタブに...
-
Word:差し込み印刷時に文字列...
-
エクセルの『検索と置換ボック...
-
ワードで複数の文字を一括・連...
-
文字列に含まれているダブルク...
-
エクセルで濁点カナの変換方法...
-
word 改行マークを印刷時に表示...
-
セルの文字列後ろのスペース削除
-
1文字だけ置換したい
-
【MS Office Word 2007】文章の...
-
Excelで特定の文字以下を削除し...
-
エクセルの「置換」で1行の部分...
-
Excel : テキストボックス中の...
-
.txtファイルの空白を全て消去...
おすすめ情報