エクセルVBA100本ノック。１６本目：無駄な改行を削除

この記事から得るもの

無駄な改行の削除方法。
置換されたかどうかの判定方法。

目次
　 １　今回のお題
　 ２　今回のお題の意図
　 ３　回答
　 ４　一言　

１　今回のお題

セル内改行はAlt+Enterですね。
引数の文字列から無駄な改行（LF）を削除して返すFunctionを作成してください。
※CRLFはLFに変換する。
■無駄な改行とは
・文字列の前後の改行
・2連続の改行

excel-ubara.com

２　今回のお題の意図

必要な改行は残しつつも、必要のない改行は削除する。

３　回答

今回も全く思いつきませんでした。なので、１から作り上げ。

私の最初の回答

Function Delete_LF_1(ByVal Targetstr As String)

Targetstr = Replace(Targetstr, vbLf & vbLf, vbLf)
Targetstr = Replace(Targetstr, vbLf & vbLf, vbLf)

Delete_LF_1 = Targetstr

End Function

お題をクリアするためだけのFunctionですね(;^ω^)。
Replace(Targetstr, vbLf & vbLf, vbLf)、この処理をループさせればいいとは気づいていたのですが、具体的な方法がわからずにカンニング。
結論、Len関数で置換前の文字数と置換後の文字数を比較して、文字数が同じになるまでループ。つまり、置換して文字数が変わらなかったということ。

置換前の文字数と置換後の文字数を比較して、文字数が同じになるまでループコード

Function Delete_LF(ByVal Targetstr As String)

Dim textLen As Integer

'改行コードの置換
Targetstr = Replace(Targetstr, vbCrLf, vbLf)

Do
    '置換前の文字数
    textLen = Len(Targetstr)
    
    '置換
    Targetstr = Replace(Targetstr, vbLf & vbLf, vbLf)

Loop Until textLen = Len(Targetstr) '置換後の文字数を比較

Delete_LF = Targetstr

End Function

これではまだ不備があります。先頭、末尾に改行がある場合は対応できません。
なので、対応したのが以下のコード

先頭、末尾に対応

Function Delete_LF_2(ByVal Targetstr As String)

Dim textLen As Integer

'改行コードの置換
Targetstr = Replace(Targetstr, vbCrLf, vbLf)

Do
    '置換前の文字数
    textLen = Len(Targetstr)
    
    '置換
    Targetstr = Replace(Targetstr, vbLf & vbLf, vbLf)

Loop Until textLen = Len(Targetstr) '置換後の文字数を比較


'先頭、末尾の改行を削除
If Left(Targetstr, 1) = vbLf Then Targetstr = Mid(Targetstr, 2)
If Right(Targetstr, 1) = vbLf Then Targetstr = Left(Targetstr, Len(Targetstr) - 1)


Delete_LF_2 = Targetstr

End Function

これで完成です。

４　一言

あると便利な処理ですね。無駄に改行使いまくる人もいるので。必要な部分だけを残す勉強になりました。

ではでは、このへんで(^^)/~~~