Wordの文章中の一致した文字のある段落を削除する

MS-Wordの文章を検索して行頭に一致した文字がある段落を削除するマクロを作りたいと思いチャレンジしています。

たとえば，文章を頭から順に検索して，行頭にある文字が検索文字と一致した場合，その段落を削除して，次の行を検索し続け，文書が終わったら終了するようなマクロです。

小生，WordVBAを２日ほど前から学び始めたばかりで，ネットや参考書を探しまして，"@"マークが行頭にある段落を削除するというサンプルを作るところまでは何とかできたのですが，これを文章全体に一括して実行できるマクロにするにはどうすればよいかに手こずっています。

このマクロがあると仕事の効率がぐんとアップしますので，何とかしたいと思っています。
是非ご教いただければ大変ありがたく思います。

＜サンプル＞
Sub test_DeleteParagraph()
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue

If .Execute(FindText:="@", Forward:=True, Format:=True) = True Then
Selection.HomeKey Unit:=wdLine, Extend:=wdMove
Selection.MoveDown Unit:=wdParagraph, Extend:=wdExtend
lVal = Selection
End If
Selection.Delete
End With
Selection.Find.ClearFormatting
End Sub

No.3 回答者： enunokokoro 回答日時： 2014/04/12 00:49

No.1の回答者です。

No.2の回答でスキルがないので分からないと書きましたが、スキル向上
のために調べてみるとWordマクロでもLeft関数が使えるようですね。
これを利用して、先頭の文字列が2文字以上でも検索できるものを用意しました。

Sub test6_DeleteParagraph()
' test5_の改良版

Dim para As Paragraph
Dim Npara As Variant
Dim LeftString As String

For Each para In ActiveDocument.Paragraphs
' 指定文字があったら段落として選択
　With para
　' 左から2文字目までの文字列を指定
　LeftString = Left(para, 2)
　　If LeftString = "|v" Then
　　　.Range.Select
　　　Npara = para
' 選択範囲を次の段落まで拡張
　　　With Npara
　　　　.Expand Unit:=wdParagraph
　　　　.MoveEnd Unit:=wdParagraph, Count:=1
　　　　.Delete
　　　End With
　　End If
　End With
Next

End Sub

マクロの中の　LeftString = Left(para, 2)　で段落内の左から2文字
を取得して、指定文字列と取得した文字列が一致した段落と次の段落を
削除するようにしたものです。
たぶん、この回答で希望していることができると思います。

この質問に回答することで、少しですがスキルが向上したので、私個人として
勉強になりました。

No.2 回答者： enunokokoro 回答日時： 2014/04/11 17:04

No.1の回答者です。

test2_DeleteParagraphのマクロでは、検索した文字列のある段落範囲
に拡張されませんでしたね。
Selection.Findだけの場合は、前のままのRange.Expandでの拡張範囲の
設定ができないためでしたね。

前のものを修正してもよいのですが、面倒なのでRange.Expandを使える
方法を新たに作り直しました。

Sub test4_DeleteParagraph()
' test2_の改良版

Dim rng As Range
Set rng = ActiveDocument.Range(0, 0)
' 検索文字を指定
With rng.Find
　.Text = "@"
End With


' 検索結果がTrueなら、次の段落まで拡張して削除を繰り返し
　With rng
　　Do While .Find.Execute = True
　　　.Expand Unit:=wdParagraph
　　　.MoveEnd Unit:=wdParagraph, Count:=1
　　　.Delete
　　Loop
　End With

End Sub


前の回答でも書きましたが、上記マクロは段落内に特定の文字があった
場合に、次の段落まで拡張して削除をするものです。検索する文字列が
段落内のどこにあっても、段落ごと削除されます。

段落先頭の文字が条件なら、以下の修正マクロでも可能です。

Sub test5_DeleteParagraph()
' test3_の改良版

Dim para As Paragraph
Dim Npara As Variant


For Each para In ActiveDocument.Paragraphs
' 指定文字があったら段落として選択
　With para
　　If .Range.Characters.First = "＠" Then
　　　.Range.Select
　　　Npara = para
' 選択範囲を次の段落まで拡張
　　　With Npara
　　　　.Expand Unit:=wdParagraph
　　　　.MoveEnd Unit:=wdParagraph, Count:=1
　　　　.Delete
　　　End With
　　End If
End With
Next

End Sub

このマクロの場合、先頭の1文字のみ対象にしていて、先頭以外に指定の
文字があっても削除されません。
それと、文字数は2文字以上を対象にはできません。
先頭の2文字以上を指定する方法は、私のスキルでは分かりません。

No.1 回答者： enunokokoro 回答日時： 2014/04/10 18:56

以下のように修正すれば可能だと思います。

Sub test2_DeleteParagraph()

Selection.HomeKey Unit:=wdStory, Extend:=wdMove
Selection.Find.ClearFormatting

　With Selection.Find
' Selection.Findを使う場合は条件を入れたほうが良い
　　.Format = True
　　.Text = "@"
　　.Forward = True
　　.ClearFormatting
　　.MatchWholeWord = True
　　.MatchCase = False
　　.Wrap = wdFindContinue
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchWildcards = False
　　.MatchFuzzy = False
　　
' 検索結果がTreeなら、段落まで拡張して削除を繰り返し
　　With Selection
　　　Do While .Find.Execute = True
　　　　.Range.Expand Unit:=wdParagraph
　　　　.Delete
　　　Loop
　　End With

　End With

End Sub

上記マクロは、段落内に特定の文字があった場合に、段落へと拡張して
削除をするものですが、段落先頭の文字が条件なら、以下のマクロでも
可能です。

Sub test3_DeleteParagraph()
Dim para As Paragraph

For Each para In ActiveDocument.Paragraphs
　With para
　　If .Range.Characters.First = "＠" Then
　　　.Range.Delete
　　End If
　End With
Next

End Sub

この回答への補足

あれからいろいろ試してみました。

行頭の2文字を検索する件については，ワードの置換機能を使って事前に「＠」に置換しておくことで対応しようと思います。

その後，このマクロを実行することで，行頭に「＠」がある段落がまず削除され，その次の段落も削除されるようになりました。

親切にアドバイスいただきありがとうございました。


＜サンプル＞
Sub DeleteParagraph()

Selection.HomeKey Unit:=wdStory, Extend:=wdMove
Selection.Find.ClearFormatting

With Selection.Find
' Selection.Findを使う場合は条件を入れたほうが良い
.Format = True
.Text = "@"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False

' 検索結果がTreeなら、段落まで拡張して削除を繰り返し
With Selection
Do While .Find.Execute = True
Selection.HomeKey Unit:=wdLine, Extend:=wdMove
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete
Selection.HomeKey Unit:=wdLine, Extend:=wdMove
Selection.MoveDown Unit:=wdParagraph, Extend:=wdExtend
Selection.Delete
Loop
End With

End With

End Sub

補足日時：2014/04/11 10:39

この回答へのお礼

早速のアドバイスをありがとうございました。

ご教示いただいたスクリプトで試してみました。

test2_DeleteParagraphでは，"@"は削除されたのですが，そのあとのテキストは残ってしまいました。
段落の削除が上手くいかないようです。

test3_DeleteParagraphでは，"@"が行頭にある段落が見事に削除されました。

これらのスクリプトを手本にして，行頭に"|v"のある段落を削除し，さらにその次の段落も削除するマクロを作りたいと思っています。

いろいろと試していますが，なかなかうまくいきません。

test2_DeleteParagraphでは，どうしても次の段落が削除できません。

test3_DeleteParagraphでは，行頭の検索が2文字になってしまいますので，このままではできないため試行錯誤していおります。

もしお時間がありましたら，アドバイスをいただけると大変ありがたいです。

よろしくお願いいたします。

お礼日時：2014/04/11 08:55