VBA100本ノック 16本目：無駄な改行を削除

公開日：2020-11-04　最終更新日：2021-01-13

VBA100本ノック 16本目：無駄な改行を削除

文字列内の無駄な改行コードを削除する問題です。
エクセルのセル内改行はLFですが、無駄に多く入っている改行コードを削除します。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

#VBA100本ノック 16本目
セル内改行はAlt+Enterですね。
引数の文字列から無駄な改行（LF）を削除して返すFunctionを作成してください。
※CRLFはLFに変換する。
■無駄な改行とは
・文字列の前後の改行
・2連続の改行
サンプル:改行(\n)
\n無駄な\n\n改行を\n\n\n削除\n\n
↓
無駄な\n改行を\n削除

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

#VBA100本ノック 16本目解答
文字列操作としては基本になります。
・Do...Loop（再帰含む）
・正規表現
・Split+Join(TEXTJOIN含む)
・１文字ずつ処理
・その他
大きくわけるとこのようになると思います。
まずは基本と言いますか、最も単純な方法のDo…Loopから。


  
    
      Function VBA100_16_01(ByVal arg As String) As String

　　arg = Replace(arg, vbCrLf, vbLf)

　　

　　Dim oLen As Long

　　Do

　　　　oLen = Len(arg)

　　　　arg = Replace(arg, vbLf & vbLf, vbLf)

      　　Loop Until Len(arg) = oLen

      　　

　　If Left(arg, 1) = vbLf Then arg = Mid(arg, 2)

　　If Right(arg, 1) = vbLf Then arg = Left(arg, Len(arg) - 1)

　　VBA100_16_01 = arg

End Function

文字列操作では必ず出てくる正規表現。
なかなか使いこなすのは大変ですが、使えるととても便利です。
すこしずつ慣れていければ良いと思います。
Split+Join、１文字ずつ処理、その他、これらのサンプルVBAは記事補足に掲載しました。


  
    
      Function VBA100_16_02(ByVal arg As String) As String

　　With CreateObject("VBScript.RegExp")

　　　　.Global = True

      　　　　.Pattern = "^\n+|\n+$|\n+(?=\n)"

　　　　VBA100_16_02 = .Replace(Replace(arg, vbCrLf, vbLf), "")

　　End With

End Function

補足

Do...Loop（再帰含む）

Do...Loopの終了条件は、置換する文字が無くなるまでになります。
先のVBAでは、Len関数でReplace前後の文字列長に変化がなくなるまでにしています。
もっと単純に、置換対象の文字がなくなるまでという判定もできます。


  
    
      　　Do While InStr(arg, vbLf & vbLf) > 0

　　　　arg = Replace(arg, vbLf & vbLf, vbLf)

　　Loop

vbLf & vbLf
これが2回出てきてしまうので、この場合は事前に変数に入れておきたいところです。

終了条件が明確なDo...Loopなので、これは結構簡単に再帰に書き換えができます。
（ただし、この内容では効率があまりよろしくないです。）
再帰についてはいずれお題を出す予定です。

正規表現

パターンの書き方はいろいろありますので、先のパターンはあくまで1例です。
CRLFの置換は、VBAのReplace一発なので、これを使っています。

VBAで正規表現を利用する（RegExp）｜VBA技術解説

・メタ文字・正規表現・正規表現RegExpの使い方・RegExpオブジェクト・RegExpの使用例・RegExp関連のオブジェクト・Execute（Matches,Match,SubMatches）の使用例・Replaceの使用例・先読み：肯定先読み、否定先読み・正規表現の実践例

Split+Join(TEXTJOIN含む)

Split関数でLFで分割して配列化してから処理するものです。
この場合、LFLFとつづいている場合は、配列内に空の要素が出来てしまうので、これの対処が必要になります。


  
    
      Function VBA100_16_04(ByVal arg As String) As String

　　If arg = "" Then Exit Function

　　Dim i As Long, v As Variant

　　Dim ary() As String

　　ReDim ary(1 To Len(arg))

　　For Each v In Split(Replace(arg, vbCrLf, vbLf), vbLf)

　　　　i = i + 1

　　　　If v <> "" Then ary(i) = v & vbLf

　　Next

　　VBA100_16_04 = Join(ary, "")

　　VBA100_16_04 = Left(VBA100_16_04, Len(VBA100_16_04) - 1)

End Function

Excel2016以降なら、シートのTEXTJOIN関数が使えます。
これなら、空の要素を無視してくれるので、とても簡単に済みます。


  
    
      Function VBA100_16_05(ByVal arg As String) As String

      　　VBA100_16_05 = WorksheetFunction.TextJoin(vbLf, True, IIf(arg = "",
      "", Split(Replace(arg, vbCrLf, vbLf), vbLf)))

End Function

１文字ずつ処理

とにかく、自力で1文字ずつLFを処理していこうというものです。


  
    
      Function VBA100_16_03(ByVal arg As String) As String

　　arg = Replace(arg, vbCrLf, vbLf)

　　

　　Dim rtn As String

　　Dim i As Long

　　Dim flgLF As Boolean

　　Dim flgOut As Boolean

　　

　　flgLF = False

　　For i = 1 To Len(arg)

　　　　flgOut = True

　　　　Select Case True

　　　　　　Case flgLF

　　　　　　　　flgLF = False

　　　　　　Case Mid(arg, i, 1) = vbLf

　　　　　　　　flgOut = False

　　　　　　Case Else

　　　　　　　　flgLF = True

　　　　End Select

　　　　If flgOut Then rtn = rtn & Mid(arg, i, 1)

　　Next

　　

　　If Right(rtn, 1) = vbLf Then rtn = Left(rtn, Len(rtn) - 1)

　　VBA100_16_03 = rtn

End Function

この方法の場合は、細部の書き方は人により千差万別になると思います。
興味があれば読み解いてみてください。

その他

今回のようなお題としては単純な処理は、方法が多種多用に存在します。
私の想像の及ばない方法もあるかもしれません。
以下は、シートのTrim関数を使った、ちょっとトリッキーな方法になります。


  
    
      Function VBA100_16_06(ByVal arg As String) As String

　　arg = Replace(arg, vbCrLf, vbLf)

　　arg = Replace(arg, " ", Chr(1))

　　arg = Replace(arg, "　", Chr(2))

　　

　　arg = Replace(arg, vbLf, " ")

　　arg = WorksheetFunction.Trim(arg)

　　arg = Replace(arg, " ", vbLf)

　　

　　arg = Replace(arg, Chr(1), " ")

　　arg = Replace(arg, Chr(2), "　")

　　VBA100_16_06 = arg

End Function

Chr(1)とChr(2)を犠牲にして、半角空白と全角空白を一旦退避してしてから、
LFを空白置換して、Trimで前後の空白と間の無駄な空白を取り除いています。
その後で、空白をLFに戻して、Chr(1)とChr(2)に変更しておいた半角・全角空白を元に戻しています。

Chr(1)とChr(2)は、単に通常の入力では入らない文字コードなら何でも良いので、分かり易いコードを選んだという事です。

サイト内関連ページ

第47回．VBA関数（文字列操作,Replace,InStr,StrConv）｜VBA入門

・文字列操作に関するVBA関数の一覧・Replace関数・InStr関数・StrConv関数・最後に

VBAで正規表現を利用する（RegExp）｜VBA技術解説

同じテーマ「VBA100本ノック」の記事

13本目：文字列の部分フォント
 14本目：社外秘シート削除
 15本目：シートの並べ替え
16本目：無駄な改行を削除
17本目：重複削除（ユニーク化）
18本目：名前定義の削除
 19本目：図形のコピー
 20本目：ブックのバックアップ
 21本目：バックアップファイルの削除
 22本目：FizzBuzz発展問題
 23本目：シート構成の一致確認

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.RangeとCellsの使い方｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
16本目：無駄な改行を削除

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 16本目：無駄な改行を削除