コピペで使えるVBA!複数セルの文字を結合するコード

VBA

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

結合の方法としてjoin関数を使用しています。

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

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

サンプルでは1行だけですが複数行でも対応しています。

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

カンマで結合

右へ表示

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

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 カンマで結合、右へ表示()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

右へ表示、元の文字は削除

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

A B C D E
1 aaa bbb ccc ddd

実行後

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

Sub カンマで結合、右へ表示、元の文字は削除()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
        For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

左に表示、元の文字は削除

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

A B C D E
1 aaa bbb ccc ddd

実行後

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

Sub カンマで結合、左へ表示、元の文字は削除()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
        For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(1).Column) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

好きな文字で結合

右へ表示

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

A B C D E
1 aaa bbb ccc ddd

メッセージBOXへハイフンを入力してOK

実行後

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

 


Sub 好きな文字で結合、右へ表示()
    区切り文字 = InputBox(prompt:="好きな区切り文字を入力してください。", Default:=",")
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), 区切り文字)
    Next
End Sub

右へ表示、元の文字は削除

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

A B C D E
1 aaa bbb ccc ddd

メッセージBOXへハイフンを入力してOK

実行後

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

Sub 好きな文字で結合、右へ表示、元の文字は削除()
    区切り文字 = InputBox(prompt:="好きな区切り文字を入力してください。", Default:=",")
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
        For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), 区切り文字)
    Next
End Sub

左に表示、元の文字は削除

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

A B C D E
1 aaa bbb ccc ddd

メッセージBOXへハイフンを入力してOK

実行後
A B C D E
1 aaa-bbb-ccc-ddd

Sub 好きな文字で結合、左へ表示、元の文字は削除()
    区切り文字 = InputBox(prompt:="好きな区切り文字を入力してください。", Default:=",")
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(1).Column) = Join(WorksheetFunction.Index(選択範囲, R), 区切り文字)
    Next
End Sub

アレンジするポイント

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

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

Sub カンマで結合、右へ表示()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

変更後

Sub カンマで結合、右へ表示()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ".")
    Next
End Sub

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

元のコード

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

Sub カンマで結合、右へ表示()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
#ここへ合体させたいコードを貼り付ける
End Sub

合体させるコード

グレー部分をコピー

Sub カンマで結合、左へ表示、元の文字は削除()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
        For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(1).Column) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

合体後のコード

Sub カンマで結合、右へ表示()
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(Selection.Count).Column + 1) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
    選択範囲 = Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row + 1, Selection(Selection.Count).Column))
    Selection.ClearContents
        For R = 1 To UBound(選択範囲, 1) - 1
        Cells(Selection(1).Row + R - 1, Selection(1).Column) = Join(WorksheetFunction.Index(選択範囲, R), ",")
    Next
End Sub

コメント

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