読者です 読者をやめる 読者になる 読者になる

ヲタク系女子がママになりました

漫画とアニメとゲームをこよなく愛する日々に、育児が追加されました。

【VBA】連続した空白行を1行にする


 
空白行が1行だったり2行だったり、混在している場合って意外と多いんですよね。以前はページ数が少ないため、地道に行を削除していましたが、作業量が多くなってくると話は別です。
 
マクロで一括置換して業務効率化を図るべく、試行錯誤しました。空白行をすべて削除するのではなく、1行だけ残したい人向けです。
 

余分な空白行を詰める

連続した2行以上の空白行があるとき、1行にするマクロです。ついでに文書の最後にある空白行も削除します。
 
ワイルドカードを使うためには、「あいまい検索(日)」をオフにする必要があります。「あいまい検索(日)」は既定値がTrueになっており、ワイルドカードとは併用できないため、先にFalseの記述をします。
 

Sub 連続した空白行を圧縮()
 
Dim allRange As Range
Dim endRange As Range
 
Set allRange = ActiveDocument.Range(0, 0)
Set endRange = ActiveDocument.Range(ActiveDocument.Range.End - 4, ActiveDocument.Range.End - 4)
 
'空白行を1行に詰める
With allRange.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13{3,}" '検索する文字列
    .Replacement.Text = "^p^p" '置換後の文字列
    .Wrap = wdFindStop '「文書の初めから検索し直す」をストップ
    .MatchFuzzy = False 'あいまい検索(日)をオフ
    .MatchWildcards = True 'ワイルドカードを使用する
    .Execute Replace:=wdReplaceAll 'すべて置換
End With
 
'最終行の空白行を詰める
With endRange.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13{2,}" '検索する文字列
    .Replacement.Text = "" '置換後の文字列
    .Wrap = wdFindStop '「文書の初めから検索し直す」をストップ
    .MatchFuzzy = False 'あいまい検索(日)をオフ
    .MatchWildcards = True 'ワイルドカードを使用する
    .Execute Replace:=wdReplaceAll 'すべて置換
End With
 
Set allRange = Nothing
Set endRange = Nothing
  
End Sub