[Excel VBA] セル内の文字列の最後に改行を入れる、改行ごとに連番を振る

実行すると選択した範囲内のセルを処理します。

コードの初めに指定した各判別フラグにより、呼びだす関数を指定します。

呼び出す関数により、このコードでは次のような処理ができます。

  • セル内の文字列の最後に改行を入力
  • セル内の文字列の最後の改行を削除
  • 行頭に連番+「.」を入力(空行以外)
  • 行頭の連番+「.」を削除
  • 行頭に「・」(中黒)を入力(空行以外)
  • 行頭の「・」(中黒)を削除
  • 前後の文字をカスタムしたステップ番号を入力
  • 連番のピリオドの後ろにスペースを入力
  • 連番のピリオドの後ろのスペースを削除

操作手順などを書くことが多いので、その作業を楽にするために作成したものです。

判別フラグはユーザフォームから設定することを想定していますが、ここではコピペですぐに使えるようにコメントアウトで処理の判定フラグを切り替えて実行できるようにしています。

スポンサーリンク

セル内の文字列に連番を入れたりする

Public Sub Main_Operation()

    Dim Target_Sheet As Worksheet

    Dim Write_Text As String

    Dim Last_Return_Flag As Boolean
    Dim Add_Num_Flag As Boolean
    Dim Space_Flag As Boolean
    Dim Insert_Space As String
    Dim Select_Processing As String

    '処理対象を記憶
    Set Target_Sheet = ActiveWorkbook.ActiveSheet

    '改行やスペースを入れるか否かのフラグを初期化
    Last_Return_Flag = false
    Space_Flag = False

    '------------※以下、実際にはユーザフォームからの選択を想定------------
    
    '実行したい処理の判別文字を指定する

    '改行処理を行う
    Select_Processing = "return"
    '文字列の最後に改行を入れるならTrue
    Last_Return_Flag = True

    'ステップ番号を振る
    'Select_Processing = "add_num"

    'ステップ番号のピリオドの後にスペースを入れたり消したりする
    'Select_Processing = "space"

    'ステップ番号や中黒を消す
    'Select_Processing = "delete_num"
    
    'ステップ番号と中黒の処理の場合の判定フラグ------------------
    
    'ステップ番号を処理する場合はTrue、中黒を処理する場合はFalse
    Add_Num_Flag = False

    'ステップ番号処理の番号の後ろにスペースを入れるならTrue
    'Space_Flag = True

    '------------ユーザフォームからの選択を想定 ここまで------------

    '描画など無効
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    '対象シートをアクティブにする
    Target_Sheet.Activate

    '選択したセル内をループ
    For Each Select_Cell In Selection

        '対象シートをアクティブにする
        Target_Sheet.Activate

        '設定値で分岐させて各処理の関数を呼ぶ---------------------

        If Select_Processing = "return" Then
        '改行を入れたり消したりする

            '対象セルの文字列と最後に改行を入れるかのフラグを引数に改行処理の関数を呼び出す
            Write_Text = Return_Operation(Select_Cell.Value, Last_Return_Flag)

            '対象セルを改行を処理した値に置き換える
            Select_Cell.Value = Write_Text

        ElseIf Select_Processing = "add_num" And Add_Num_Flag = True Then
        'ステップ番号を振る

            '対象セルの文字列を引数にステップ番号を削除する関数を呼び出す
            Write_Text = Delete_Serial_Number(Select_Cell.Value)

            '対象セルをステップ番号を削除した値に置き換える
            Select_Cell.Value = Write_Text

            '対象セルの文字列とスペースを入れるかフラグを引数にステップ番号処理の関数を呼び出す
            Write_Text = Serial_Number_Text(Select_Cell.Value, Space_Flag)

            '対象セルをステップ番号を振った値に置き換える
            Select_Cell.Value = Write_Text

        ElseIf Select_Processing = "add_num" And Add_Num_Flag = False Then
        '中黒を打つ

            '対象セルの文字列を引数に中黒を削除する関数を呼び出す
            Write_Text = Delete_Dot(Select_Cell.Value)

            '対象セルをステップ番号を削除した値に置き換える
            Select_Cell.Value = Write_Text

            '対象セルの文字列を引数にステップ番号処理の関数を呼び出す
            Write_Text = Dot_Text(Select_Cell.Value)

            '対象セルをステップ番号を振った値に置き換える
            Select_Cell.Value = Write_Text

        ElseIf Select_Processing = "space" Then
        'ステップ番号のピリオドの後にスペースを入れたり消したりする

            '対象セルの文字列とスペースを入れるかフラグを引数にステップ番号の後ろのスペースを追加したり削除する関数を呼び出す
            Write_Text = Space_Serial_Number(Select_Cell.Value, Space_Flag)

            '対象セルをスペースを追加や削除した値に置き換える
            Select_Cell.Value = Write_Text

        ElseIf Select_Processing = "delete_num" And Add_Num_Flag = True Then
        'ステップ番号を消す

            '対象セルの文字列を引数にステップ番号を削除する関数を呼び出す
            Write_Text = Delete_Serial_Number(Select_Cell.Value)

            '対象セルをステップ番号を削除した値に置き換える
            Select_Cell.Value = Write_Text

        ElseIf Select_Processing = "delete_num" And Add_Num_Flag = False Then
        '中黒を消す

            '対象セルの文字列を引数に中黒を削除する関数を呼び出す
            Write_Text = Delete_Dot(Select_Cell.Value)

            '対象セルをステップ番号を削除した値に置き換える
            Select_Cell.Value = Write_Text

        End If

        '条件分岐した各処理ここまで-------------------------------

    Next Select_Cell

    '描画など無効解除
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

    'MsgBox ("処理完了")

End Sub

'改行を入れたり消したり
Function Return_Operation(ByVal Check_Text As String, ByVal Last_Return_Flag As Boolean) As String

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        'セルの文字列の最後が改行じゃなくなるまでループ
        Do

            '文字列の最後が改行か判別
            If Right(Check_Text, 1) = vbLf Then

                '文字列の最後が改行だったら、一文字削った文字列を入力
                Check_Text = Left(Check_Text, Len(Check_Text) - 1)

            Else

                '文字列の最後が改行じゃなくなったら、最後に改行を追加するかフラグを判別
                If Last_Return_Flag = True Then

                    '文字列の最後に改行を追加
                    Check_Text = Check_Text & vbLf

                End If

                'ループを抜ける
                Exit Do

            End If

        Loop

    End If

    '編集結果を戻り値に設定
    Return_Operation = Check_Text

End Function

'ステップ番号を振る
Function Serial_Number_Text(ByVal Check_Text As String, ByVal Space_Flag As Boolean) As String

    if Space_Flag = true then
        Insert_Space = " "
    else
        Insert_Space = ""
    end if

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        'ステップ番号変数を初期化
        Num_Count = 1

        For k = 1 To Len(Check_Text)

            '改行ではない1文字目の前に「1.」を振る
            If Num_Count = 1 And Mid(Check_Text, k, 1) <> vbLf Then

                Serial_Number_Text = Serial_Number_Text & Num_Count & "." & Insert_Space & Mid(Check_Text, k, 1)

                Num_Count = Num_Count + 1

            Else

                '1文字ずつTmp_Textに取得
                Serial_Number_Text = Serial_Number_Text & Mid(Check_Text, k, 1)

            End If

            '最後の文字ではない場合
            If k <> Len(Check_Text) Then

                If Mid(Check_Text, k, 1) = vbLf And Mid(Check_Text, k + 1, 1) <> vbLf Then

                    '改行があったら前の文字が改行でなければ、次の文字の前に番号をふる
                    Serial_Number_Text = Serial_Number_Text & Num_Count & "." & Insert_Space

                    Num_Count = Num_Count + 1
                End If
            End If
        Next k
    End If

End Function

'ステップ番号を消す
Function Delete_Serial_Number(ByVal Check_Text As String) As String

    '改行発見フラグ
    Dim Return_Flag As Boolean
    'ピリオド発見フラグ
    Dim Dot_Flag As Boolean
    'スペースチェックフラグ
    Dim Space_Check_Flag As Boolean
    '数字発見カウント
    Dim Num_Count As Integer

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        'フラグを初期化 ※Return_Flagは一文字目の時だけ初期値はTrue
        Return_Flag = True
        Dot_Flag = False
        Space_Check_Flag = False
        Num_Count = 0


        For i = 1 To Len(Check_Text)

            '文字を一文字取得する
            Delete_Serial_Number = Delete_Serial_Number & Mid(Check_Text, i, 1)

            '改行がみつかって改行フラグがTrueになっていたら次が数字か判別
            If Return_Flag = True Then

                If IsNumeric(Mid(Check_Text, i, 1)) = True Then

                    '数字だった場合、文字数カウントをインクリメントする
                    Num_Count = Num_Count + 1

                ElseIf Num_Count > 0 And Mid(Check_Text, i, 1) = "." Then

                    'Num_Countが1以上でピリオドだった場合、文字列を削除
                    Delete_Serial_Number = Left(Delete_Serial_Number, Len(Delete_Serial_Number) - Num_Count - 1)

                    '次がスペースだった場合はスペースも削除するためのフラグを立てる
                    Space_Check_Flag = True

                Else

                    'Space_Check_FlagがTrueでスペースだった場合、スペースを削除する
                    If Space_Check_Flag = True And Mid(Check_Text, i, 1) = " " Then

                        'Delete_Serial_Numberの文字数-1文字目までを取得することで1文字削除
                        Delete_Serial_Number = Left(Delete_Serial_Number, Len(Delete_Serial_Number) - 1)

                    End If

                    '数字や数字後のピリオドではない場合、フラグを初期化する
                    Return_Flag = False
                    Dot_Flag = False
                    Space_Check_Flag = False
                    Num_Count = 0

                End If

            End If

            If Mid(Check_Text, i, 1) = vbLf Then

                '改行が見つかったらReturn_FlagをTrueにする
                Return_Flag = True

            End If

        Next i
    End If

End Function

'ステップ番号のスペース操作
Function Space_Serial_Number(ByVal Check_Text As String, ByVal Space_Flag As Boolean) As String

    '改行発見フラグ
    Dim Return_Flag As Boolean
    'ピリオド発見フラグ
    Dim Dot_Flag As Boolean
    'スペースチェックフラグ
    Dim Space_Check_Flag As Boolean
    '数字発見カウント
    Dim Num_Count As Integer

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        'フラグを初期化 ※Return_Flagは一文字目の時だけ初期値はTrue
        Return_Flag = True
        Dot_Flag = False
        Space_Check_Flag = False
        Num_Count = 0

        For i = 1 To Len(Check_Text)

            '文字取得フラグを初期化
            Tmp_Flag = 1

            '改行がみつかって改行フラグがTrueになっていたら次が数字か判別
            If Return_Flag = True Then

                If IsNumeric(Mid(Check_Text, i, 1)) = True And Space_Check_Flag = False Then

                    '数字だった場合、文字数カウントをインクリメントする
                    Num_Count = Num_Count + 1

                ElseIf Num_Count > 0 And Mid(Check_Text, i, 1) = "." Then

                    '次がスペースか確認するためにスペースフラグを立てる
                    Space_Check_Flag = True

                Else

                    If Space_Check_Flag = True Then

                        If Space_Flag = True And Mid(Check_Text, i, 1) <> " " Then

                            'Space_Check_FlagとSpace_FlagがTrueでスペースではなかった場合、スペースを入れる
                            Tmp_Flag = 0

                        ElseIf Space_Flag = False And Mid(Check_Text, i, 1) = " " Then

                            'Space_FlagがFalseでスペースだった場合、文字を取得しない
                            Tmp_Flag = 2

                        End If

                    End If

                    '数字や数字後のピリオドではない場合、フラグを初期化する
                    Return_Flag = False
                    Dot_Flag = False
                    Space_Check_Flag = False

                End If

            End If

            '文字取得処理
            If Tmp_Flag = 0 Then

                'スペースを入れる
                Space_Serial_Number = Space_Serial_Number & " "

                '文字を一文字取得する
                Space_Serial_Number = Space_Serial_Number & Mid(Check_Text, i, 1)

            ElseIf Tmp_Flag = 1 Then

                'そのまま取得する
                Space_Serial_Number = Space_Serial_Number & Mid(Check_Text, i, 1)

            End If


            If Mid(Check_Text, i, 1) = vbLf Then

                '改行が見つかったらReturn_FlagをTrueにする
                Return_Flag = True
            End If

        Next i
    End If

End Function

'中黒を打つ
Function Dot_Text(ByVal Check_Text As String) As String

    First_Flag = True

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        For k = 1 To Len(Check_Text)

            '改行ではない1文字目の前に「・」を打つ
            If First_Flag = True And Mid(Check_Text, k, 1) <> vbLf Then

                Dot_Text = Dot_Text & "・" & Mid(Check_Text, k, 1)

                First_Flag = False

            Else

                '1文字ずつ戻り値に取得
                Dot_Text = Dot_Text & Mid(Check_Text, k, 1)

            End If

            '最後の文字ではない場合
            If k <> Len(Check_Text) Then

                If Mid(Check_Text, k, 1) = vbLf And Mid(Check_Text, k + 1, 1) <> vbLf Then

                    '改行があったら前の文字が改行でなければ、次の文字の前に「・」を打つ
                    Dot_Text = Dot_Text & Num_Count & "・"

                End If
            End If
        Next k
    End If

End Function

'中黒を消す
Function Delete_Dot(ByVal Check_Text As String) As String

    '改行発見フラグ
    Dim Return_Flag As Boolean

    '空欄ではなければ処理する
    If Check_Text <> "" Then

        'フラグを初期化 ※Return_Flagは一文字目の時だけ初期値はTrue
        Return_Flag = True

        For i = 1 To Len(Check_Text)

            '文字を一文字取得する
            Delete_Dot = Delete_Dot & Mid(Check_Text, i, 1)

            If i = 1 And Mid(Check_Text, i, 1) = vbLf Then
                '1文字目が改行だったらフラグを初期化する
                Return_Flag = False

            End If

            '改行がみつかって改行フラグがTrueになっていたら次が中黒か判別
            If Return_Flag = True Then

                If Mid(Check_Text, i, 1) = "・" Then

                    '中黒だった場合、文字列を削除
                    Delete_Dot = Left(Delete_Dot, Len(Delete_Dot) - 1)

                End If

                'フラグを初期化する
                Return_Flag = False

            End If

            If Mid(Check_Text, i, 1) = vbLf Then

                '改行が見つかったらReturn_FlagをTrueにする
                Return_Flag = True

            End If

        Next i
    End If

End Function
スポンサーリンク

説明

「※以下、実際にはユーザフォームからの選択を想定」の部分で、処理をする内容の判定フラグを設定しています。

ユーザフォームを作成した方が使いやすいです。

そして「設定値で分岐させて各処理の関数を呼ぶ」の部分で、判定して各関数を呼び出しています。

使い方

ソースコードを保存したファイルとは異なるブックに対して使うことを想定しています。

使い方は以下の流れになります。

  1. このソースコードを保存したファイルを開く
  2. 操作したいブックを開き、処理をしたい範囲を選択状態にする
  3. 操作したいブックが最前面にある状態でメニューバーから[開発]-[マクロ]を選択するか Alt + F8 キー
  4. 展開したマクロのダイアログで「Main_Operation」を選択して[実行]ボタンを押下

ソースコードの記載されたブックではなく、操作したいブックからコードを実行する必要があります。

選択範囲については、連続しない複数の範囲選択でも動作可能です。

ここからは、処理をする内容と判定フラグの設定値を説明します。

セル内の文字列の最後に改行を入力

「セルに納まっているはずなのに、印刷するときに見切れるから、最後に空行を入れてほしい」と言われることが多かったので対応した機能です。

選択範囲のセル内にある文字列の最後に空行を一行追加します。

また、文字列の最後に複数行の空行があった場合は一行に減らします。

設定値は次のように設定すると実行できます。

  • Select_Processing = “return”
  • Last_Return_Flag = True

セル内の文字列の最後の改行を削除

「印刷するときに見切れるから」と入力された最後の空行が気に入らない場合に削除できます。

セル内の文字列の最後に複数行の空行があった場合は、全て削除します。

設定値は次のように設定すると実行できます。

  • Select_Processing = “return”
  • Last_Return_Flag = False

行頭に連番+「.」を入力(空行以外)

手順などを作成する際の連番を行頭に追加します。

数字とピリオドが1セットになっています。

設定値は次のように設定すると実行できます。

  • Select_Processing = “add_num”
  • Add_Num_Flag = True

また、連番の後に半角スペースを入れたい場合は「Space_Flag = True」、入れたくない場合は「Space_Flag = False」を設定すると半角スペースの設定ができます。

行頭の連番+「.」を削除

設定された連番とピリオドを削除します。

ピリオドの後に半角スペースが入っていた場合は、半角スペースも削除します。

設定値は次のように設定すると実行できます。

  • Select_Processing = “delete_num”
  • Add_Num_Flag = True

行頭に「・」(中黒)を入力(空行以外)

連番ではなく、箇条書きのように文字列の行頭に中黒を打ちます。

空行には中黒を打ちません。

設定値は次のように設定すると実行できます。

  • Select_Processing = “add_num”
  • Add_Num_Flag = False

行頭の「・」(中黒)を削除

文字列の行頭に打たれた中黒を削除します。

行頭以外の中黒は削除されません。

設定値は次のように設定すると実行できます。

  • Select_Processing = “delete_num”
  • Add_Num_Flag = False

連番のピリオドの後ろにスペースを入力

連番のピリオドの後ろに半角スペースを入れたがる人がいたので、後から追加できるようにしました。

数字とピリオドの組み合わせの後に半角スペースを差し込みます。

設定値は次のように設定すると実行できます。

  • Select_Processing = “space”
  • Space_Flag = True

連番のピリオドの後ろのスペースを削除

連番のピリオドの後ろに半角スペースが入っているのが気に入らないときの削除処理です。

設定値は次のように設定すると実行できます。

  • Select_Processing = “space”
  • Space_Flag = False

おわりに

これらの設定値を手動で切り替えるのは、大変です。

何度も使用する予定であれば、ユーザフォームの作成をおすすめします。

タイトルとURLをコピーしました