質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.53%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

Q&A

解決済

2回答

9970閲覧

【VBA】ExcelからWord操作:文字列を検索して結果出力したい

jumpeiiii

総合スコア12

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

0グッド

0クリップ

投稿2022/01/19 06:14

編集2022/01/24 18:29

実現したいこと

エクセルの<検索文字列>シートのA列に列挙されている検索文字列群(A1からA2、A3、、、に検索したい文字が入力されています)がwordファイルの文章中に使われているかそれぞれ検索し、出現ページ・行を<結果>シートに出力したい。

エラー・回避したいこと

wordファイルの文章中の検索対象文字列にルビがふられていた場合、無限ループになってしまう。
例)「回避」が検索文字列で、wordファイルの文章のどこかで「回避」という文字が使われており、さらに「かいひ」とwordのルビ機能を使ってルビがふられていた場合に、無限ループになって固まってしまいます。
いろいろ調べてみましたが自分の力では回避できなかったのでこちらで質問させていただきます。

コード

maxRowは<検索文字列>シートの最終行番号が格納
iRowは<結果>シートの結果を書き出す開始行番号が格納

vba

1 For i = 1 To maxRow 2 wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value 3 With wdApp.Selection 4 .Find.Text = wd 5 .Find.Forward = True 6 .Find.MatchWholeWord = True 7 .Find.MatchCase = True 8 .Find.Wrap = wdFindContinue 9 Do While .Find.Execute 10 p = .Range.Information(wdActiveEndPageNumber) 11 l = .Range.Information(wdFirstCharacterLineNumber) 12 With ThisWorkbook.Worksheets("結果") 13 .Range("A" & iRow) = p & "P、" & l & "行目" 14 .Range("B" & iRow) = wd 15 End With 16 iRow = iRow + 1 17 Loop 18 End With 19 Next 20

環境

Excel 2016、Word 2016、VBA 7.1

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

自己解決

質問時のコードに対し、2か所修正して解決できました。

①ページ番号および行番号を取得する際のRangeオブジェクトを変更
.Find.Executeしてヒットした際に、.Range.Information(略)が実行されると、ルビの場合には次に移らずハマって無限ループとなっていました。(ルビがふられている場合、カーソルを合わせると自動でルビの文字全体が選択される仕様が関係しているのかと思われますが詳細はよくわかりません。)
これを回避するため、Rangeオブジェクトではなく、そのままSelectionオブジェクトのInformationを取得するようにしました。
↓の部分を、

vba

1 p = .Range.Information(wdActiveEndPageNumber) 2 l = .Range.Information(wdFirstCharacterLineNumber)

↓のように修正

vba

1 p = .Information(wdActiveEndPageNumber) 2 l = .Information(wdFirstCharacterLineNumber)

②検索文字列が変わるごとにカーソルを文頭に移動させる
もともとのコードですと次の検索文字列に移った際に文章の途中から検索を開始して、結果が重複して出力される状態でした。そのため、次の文字列に移った場合は文頭から検索されるよう、カーソルを文頭に移動させるようにしました。
↓のコードを追加

vba

1 .Move Unit:=wdStory, Count:=-1 '文章の先頭にカーソルを移動

解決できたコードは以下のとおりです。

vba

1 For i = 1 To maxRow 2 wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value 3 With wdApp.Selection 4 .Move Unit:=wdStory, Count:=-1 '文章の先頭にカーソルを移動 5 .Find.Text = wd 6 .Find.Forward = True 7 .Find.MatchWholeWord = True 8 .Find.MatchCase = True 9 .Find.Wrap = wdFindContinue 10 Do While .Find.Execute 11 p = .Information(wdActiveEndPageNumber) 12 l = .Information(wdFirstCharacterLineNumber) 13 With ThisWorkbook.Worksheets("結果") 14 .Range("A" & iRow) = p & "P、" & l & "行目" 15 .Range("B" & iRow) = wd 16 End With 17 iRow = iRow + 1 18 Loop 19 End With 20 Next 21

投稿2022/01/24 09:07

編集2022/01/24 09:16
jumpeiiii

総合スコア12

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ken3memo

2022/01/24 09:29

>(ルビがふられている場合、カーソルを合わせると自動でルビの文字全体が選択される仕様が関係しているのかと思われますが詳細はよくわかりません。) 本筋の.Find.で無限ループになる原因がわかって、よかったてす。 私も、すっきりしました。
guest

0

処理イメージは下記のような感じで良いですか?
https://youtu.be/dSlL0aNsI28?t=76
↑実行結果の動画です、確認してみてください

.Findでループしてしまう理由が私もわからなかったので、
ActiveDocument.Paragraphs から 泥臭く探ってみました
※maxRow = 3 '最終行を代入してね テストで3個固定なので、修正してね

VBA

1Sub test20220121WORD検索テスト2() 2 3 Dim wdApp As Word.Application 4 Set wdApp = GetObject(, "Word.Application") 5 6 If wdApp Is Nothing Then 7 MsgBox "テスト用のWORD文章を開いてから、再テストしてね" 8 Exit Sub 9 End If 10 11 Dim i As Integer 12 Dim iRow As Integer 13 14 Dim maxRow As Integer 15 Dim wd As String 16 Dim p As Integer, l As Integer 'ページ、行 17 18 Dim n As Integer '段落のカウンターで使用 19 Dim str段落文字列 As String 20 Dim n先頭位置 As Integer 21 22 maxRow = 3 '最終行を代入してね テストで3個固定なので、修正してね 23 iRow = 1 '結果一行目から、あっ、実行時に結果のシート消さなきゃ↓・・・ 24 ThisWorkbook.Worksheets("結果").Range("A:A").Clear 'A列をクリア 25 26 For i = 1 To maxRow 27 wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value '検索文字列 28 29 'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs 30 For n = 1 To wdApp.ActiveDocument.Paragraphs.Count 31 str段落文字列 = wdApp.ActiveDocument.Paragraphs(n).Range.Text 32 '単純にInstrで探してみた 33 n先頭位置 = InStr(1, str段落文字列, wd) '初回は一文字目から探す 34 While n先頭位置 <> 0 '検索位置が見つかっている間 0以外の時ループ 35 If n先頭位置 > 0 Then '↑で文字が見つかったら、 36 wdApp.ActiveDocument.Paragraphs(n).Range.Select '見つけたので段落選択する 37 '↑段落全体が選択されているので、↓選択範囲、start位置を移動 38 wdApp.Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置 - 1 39 '結果をExcelへ書く、 40 p = wdApp.Selection.Range.Information(wdActiveEndPageNumber) 41 l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber) 42 With ThisWorkbook.Worksheets("結果") 43 .Range("A" & iRow) = p & "P、" & l & "行目" 44 .Range("B" & iRow) = wd 45 End With 46 iRow = iRow + 1 47 End If 48 49 '次の位置(見つけた位置+検索文字数)から検索文字を探す 50 n先頭位置 = InStr(n先頭位置 + Len(wd), str段落文字列, wd) '同じ段落に検索文字があるかもしれないので 51 52 Wend 53 54 Next n 55 56 Next 57 58 MsgBox "処理終了、結果を確認してください" 59 60End Sub

イメージ説明
イメージ説明

2022/01/24 ルビに対応したコードに修正

'ルビを振った文字列を検索する※ルビが別に管理されていることに気が付く・・・ Sub test20220124WORD検索テスト3ルビを探る() Dim wdApp As Word.Application Set wdApp = GetObject(, "Word.Application") If wdApp Is Nothing Then MsgBox "テスト用のWORD文章を開いてから、再テストしてね" Exit Sub End If Dim i As Integer Dim iRow As Integer Dim maxRow As Integer Dim wd As String Dim p As Integer, l As Integer 'ページ、行 Dim n As Integer '段落のカウンターで使用 Dim str段落文字列 As String Dim n先頭位置 As Integer Dim strルビ情報 As String 'ActiveDocument.Fields(n) なので、ルビ以外もあるけどね 2022/01/24追加 maxRow = 3 '最終行を代入してね テストで3個固定なので、修正してね iRow = 1 '結果一行目から、あっ、実行時に結果のシート消さなきゃ↓・・・ ThisWorkbook.Worksheets("結果").Range("A:B").Clear 'A,B列をクリア For i = 1 To maxRow wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value '検索文字列 'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs For n = 1 To wdApp.ActiveDocument.Paragraphs.Count str段落文字列 = wdApp.ActiveDocument.Paragraphs(n).Range.Text '単純にInstrで探してみた n先頭位置 = InStr(1, str段落文字列, wd) '初回は一文字目から探す While n先頭位置 <> 0 '検索位置が見つかっている間 0以外の時ループ If n先頭位置 > 0 Then '↑で文字が見つかったら、 wdApp.ActiveDocument.Paragraphs(n).Range.Select '見つけたので段落選択する '↑段落全体が選択されているので、↓選択範囲、start位置を移動 wdApp.Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置 - 1 '結果をExcelへ書く、 p = wdApp.Selection.Range.Information(wdActiveEndPageNumber) l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber) With ThisWorkbook.Worksheets("結果") .Range("A" & iRow) = p & "P、" & l & "行目" .Range("B" & iRow) = wd End With iRow = iRow + 1 End If '次の位置(見つけた位置+検索文字数)から検索文字を探す n先頭位置 = InStr(n先頭位置 + Len(wd), str段落文字列, wd) '同じ段落に検索文字があるかもしれないので Wend Next n 'ルビを探る、探す 2022/01/24 追加 For n = 1 To ActiveDocument.Fields.Count strルビ情報 = wdApp.ActiveDocument.Fields(n).Code 'フォントやフリガナ情報含む If InStr(strルビ情報, wd) > 0 Then 'Filed ルビの情報 から 検索ワードが見つかったら wdApp.ActiveDocument.Fields(n).Select '単純にSelectで選択状態にする '結果をExcelへ書く、 p = wdApp.Selection.Range.Information(wdActiveEndPageNumber) l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber) With ThisWorkbook.Worksheets("結果") .Range("A" & iRow) = p & "P、" & l & "行目" .Range("B" & iRow) = wd End With iRow = iRow + 1 End If Next n Next MsgBox "処理終了、結果を確認してください" End Sub

動画まで作成してカッコつけたのに(ぉぃぉぃ)
テスト不足ですみません。※回答を修正しました

恥の上塗りになるかもしれませんが、再チャレンジしてみました
https://www.youtube.com/watch?v=QcljoRs1Rsc
↑時間があるときに、ダメ動画も確認してみてください。

投稿2022/01/21 11:18

編集2022/01/24 07:44
ken3memo

総合スコア132

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jumpeiiii

2022/01/24 04:46 編集

ken3memo様 動画の作成までしていただきありがとうございました。 動作イメージは、作成していただいたものの通りです。 ただ、いただいたものを試したところ、word側の文章にルビがふられていた場合、その文字列は検索されませんでした。 例えば、word文書の中に、挨拶という文字列が3か所あって、これを検索文字列として検索しようとすると、1か所の挨拶には「あいさつ」とルビがふられていた場合、そこが飛ばされて2か所しか検索されませんでした。 いただいたコードを参考に、ルビがふられた文字列も検索されるほかの方法があるか自分でも考えてみたいと思います。ありがとうございました。
ken3memo

2022/01/24 07:45

あっ、ルビがふられているとダメですね 動画まで作成してカッコつけたのに(ぉぃぉぃ) テスト不足ですみません。※回答を修正しました 恥の上塗りになるかもしれませんが、再チャレンジしてみました https://www.youtube.com/watch?v=QcljoRs1Rsc ↑時間があるときに、ダメ動画も確認してみてください。
jumpeiiii

2022/01/24 09:18 編集

ken3memo様 修正いただきましてありがとうございました。 この間、最初に投稿いただいたものも参考に、自分でも修正を試みており、自己解決できましたので、掲載させていただきます。 修正いただいたコードでルビのものも検索結果として出力されましたが、検索結果として出力される順番が、ルビのものが最後になってしまいますので、自己解決とさせていただきました。お時間をいただき、いろいろとご尽力くださったのに申し訳ございません。 ルビ情報の取得やコーディングの考え方など大変勉強になりました。 ありがとうございました。また、機会がありましたらどうぞよろしくお願いします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.53%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問