コピペで使えるVBA!文字を分割するコード

VBA

VBAマクロで文字を分割するコードを紹介します。

分割の方法としてsplit関数を使用しています。

コードをコピーすればすぐに使えます。

コピペ前提なので短さを優先してコードを書きました。

また工夫したい方向けにアレンジするポイントも参考にしてください。

選択しているセルの文字を分割する

カンマ区切り、右側に横並びで表示

セルA1を選択してマクロを実行

A B C D E
1 aaa,bbb,ccc,ddd

 

実行後

A B C D E
1 aaa,bbb,ccc,ddd aaa bbb ccc ddd

 


Sub 選択セルを分割して右に横並び()
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row, Selection.Column + 1 + カウンタ) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

カンマ区切り、下に横並びで表示

セルA1を選択してマクロを実行

A B C D E
1 aaa,bbb,ccc,ddd
2

実行後

A B C D E
1 aaa,bbb,ccc,ddd
2 aaa bbb ccc ddd

Sub 選択セルを分割して下に横並び()
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row + 1, Selection.Column + カウンタ) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

カンマ区切り、下に縦並びで表示

セルA1を選択してマクロを実行

A B C D E
1 aaa,bbb,ccc,ddd
2
3
4
5

実行後

A B C D E
1 aaa,bbb,ccc,ddd
2 aaa
3 bbb
4 ccc
5 ddd

Sub 選択セルを分割して下に縦並び()
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row + 1 + カウンタ, Selection.Column) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

指定した列の文字を一括で分割する

A列を選択してマクロを実行

A B C D E
1 aaa,bbb,ccc,ddd
2 eee,fff,ggg,hhh
3
4
mmm,nnn,ooo,ppp

実行後

A B C D E
1 aaa,bbb,ccc,ddd aaa bbb ccc ddd
2 eee,fff,ggg,hhh eee fff ggg hhh
3
4 mmm,nnn,ooo,ppp mmm nnnn ooo ppp

Sub 指定した列の文字を一括で分割する()
    For 行カウンタ = 1 To Cells(Rows.Count, Selection.Column).End(xlUp).Row
        If Cells(行カウンタ, Selection.Column) Like "*,*" Then
            For 列カウンタ = 0 To UBound(Split(Cells(行カウンタ, Selection.Column), ","))
                Cells(行カウンタ, Selection.Column + 1 + 列カウンタ) = Split(Cells(行カウンタ, Selection.Column), ",")(列カウンタ)
            Next
        End If
    Next
End Sub

指定した行の文字を一括で分割する

1行を選択してマクロを実行

A B C D E
1 aaa,bbb,ccc,ddd eee,fff,ggg,hhh
mmm,nnn,ooo,ppp
2
3
4
5
実行後
A B C D E
1 aaa,bbb,ccc,ddd eee,fff,ggg,hhh
mmm,nnn,ooo,ppp
2 aaa eee mmm
3 bbb fff nnn
4 ccc ggg ooo
5 ddd hhh ppp

Sub 指定した行の文字を一括で分割する()
    For 列カウンタ = 1 To Cells(Selection.Row, Columns.Count).End(xlToLeft).Column
        If Cells(Selection.Row, 列カウンタ) Like "*,*" Then
            For 行カウンタ = 0 To UBound(Split(Cells(Selection.Column, 列カウンタ), ","))
                Cells(Selection.Row + 1 + 行カウンタ, 列カウンタ) = Split(Cells(Selection.Row, 列カウンタ), ",")(行カウンタ)
            Next
        End If
    Next
End Sub

アレンジするポイント

カンマ以外の区切り文字を使う

ドットにしたい場合は”*,*”や”,”を”*.*”と”.”に変更する

Sub 選択セルを分割して右に横並び()
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row, Selection.Column + 1 + カウンタ) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

変更後

Sub 選択セルを分割して右に横並び()
    If Selection.Value Like "*.*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, "."))
            Cells(Selection.Row, Selection.Column + 1 + カウンタ) = Split(Selection.Value, ".")(カウンタ)
        Next
    End If
End Sub

複数のコードを合体させる

元のコード

グレー部分が貼り付け場所

Sub 選択セルを分割して右に横並び()
    If Selection.Value Like "*.*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, "."))
            Cells(Selection.Row, Selection.Column + 1 + カウンタ) = Split(Selection.Value, ".")(カウンタ)
        Next
    End If
#ここへ合体させたいコードを貼り付ける
End Sub

合体させるコード

グレー部分をコピー

Sub 選択セルを分割して下に横並び()
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row + 1, Selection.Column + カウンタ) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

合体後のコード

Sub 選択セルを分割して右に横並び()
    If Selection.Value Like "*.*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, "."))
            Cells(Selection.Row, Selection.Column + 1 + カウンタ) = Split(Selection.Value, ".")(カウンタ)
        Next
    End If
    If Selection.Value Like "*,*" Then
        For カウンタ = 0 To UBound(Split(Selection.Value, ","))
            Cells(Selection.Row + 1, Selection.Column + カウンタ) = Split(Selection.Value, ",")(カウンタ)
        Next
    End If
End Sub

コメント

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