VBAで結合セルにデータを貼り付ける｜ Excel作業をVBAで効率化

マクロの概要

結合セル貼り付け処理用のフォームを用意し、テキストボックスの内容を結合セルを含む選択セル範囲に貼り付けるマクロを紹介します。

フォームの処理のためフォームの体裁やどうしてもコードが長くなるためダウンロードを用意しています。マクロの作成が面倒な方は後述からダウンロードしてください。

結合セルへの貼り付けはエラーになる

結合セルへテキストデータを貼り付けようとすると以下のように「クリップボードに保存されているデータの大きさや形が、指定された領域と異なります。貼り付けますか？」というエラーになります。

なんで貼り付けてくれないんでしょうね。Excelの不便な点の一つです。

Officeのバージョンが上がればいつか対応してくれるだろうと思っていましたが、全然対応されません。

仕方がないのでVBAで対応しましょう。

結合セルにテキストデータを貼り付ける方法

結合セルにテキストデータを貼り付けるには、F2キーやセルをダブルクリックしてセル内にカーソルを当てた状態にする必要があります。

貼り付けるデータが１つであれば手でやってもまあなんとかなりますが、これが複数になってくると時間が掛かってしょうがないです。

以下のマクロは複数のデータを選択セル範囲に一度で貼り付けを行うことができます。フォームを利用するため見た目の部分とコードの部分とフォームの呼び出し部分をそれぞれ３つに分けて説明します。

フォーム

VBA画面で以下のようにフォームを作成します。

各オブジェクト名はプロパティのオブジェクト名欄で設定します。

なお、こちら（frmSetStringUnionCell.zip）からダウンロードできます。ダウンロードしたzipを解凍すると２ファイルあります。

・frmSetStringUnionCell.frm
・frmSetStringUnionCell.frx

VBAの画面でPERSONAL.XLSBまたは追加先のブックを右クリックしてfrmSetStringUnionCell.frmをインポートするとfrxファイルも一緒に追加されます。

フォームの各項目は好きに配置しなおしたりラベルの表示文言を変えてもらって大丈夫です。オブジェクト名を変えるとコードも変える必要があるのでそこだけ注意してください。

コード

フォームのコードは以下になります。上記でダウンロードしている場合はもちろんコードを書く必要はありません。

このコードで行っている主な処理は、テキストボックスの内容を１行ずつ選択セル１つずつに貼り付けていく、というものです。

セルの選択行数と貼り付けるテキスト行数の内容は、フォームにカーソルが当たると現時点のセルの選択行数とテキストボックスの行数を表示します。

コード自体は長いのですが個別の関数は短いため、コメント含めて見てもらうとそんなに難しいものではないと思います。

Option Explicit

'// クリアボタン
Private Sub cmdClear_Click()
    txtPaste.Text = ""
End Sub

'// 貼り付けボタンクリック
Private Sub cmdPaste_Click()
    Dim ar As Variant
    ReDim ar(0)
    
    '// テキストボックスの内容を取得
    Call getPasteString(ar)
    
    '// テキストボックスの内容を結合セルに貼り付け
    Call setString(ar)
    
End Sub

'// テキストボックスの内容を配列で取得
Private Sub getPasteString(a_Ar As Variant)
    Dim s
    Dim v As Variant
    s = txtPaste.Text

    v = Split(s, vbCrLf)
    a_Ar = v
End Sub

'// 結合セルにテキストボックスの内容を貼り付け
Sub setString(a_Ar)
    Dim iRow
    Dim iCol
    Dim objRange
    Dim i
    Dim iArSize
    
    iRow = ActiveCell.Row
    iCol = ActiveCell.Column
    i = 0
    iArSize = UBound(a_Ar)
    
    For Each objRange In Selection
        If i > iArSize Then
            Exit For
        End If
        
        If (objRange.Column = iCol) Then
            ActiveCell.Offset(i, 0).Value = a_Ar(i)
            i = i + 1
        End If
    Next
End Sub

'// フォームがアクティブになったとき
Private Sub UserForm_Activate()
    '// 行数表示
    Call setLineCount
End Sub

'// フォームにマウスが重なったとき
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    '// 行数表示
    Call setLineCount
End Sub

'// 貼り付けテキストが変更されたとき
Private Sub txtPaste_Change()
    '// 行数表示
    Call setLineCount
End Sub

'// 行数表示
Private Sub setLineCount()
    lblCellLineCount.Caption = getSelectionLineCount()
    lblPasteLineCount.Caption = getPasteTextLineCount()
End Sub

'// 選択セル行数取得
Private Function getSelectionLineCount()
    Dim iRow
    Dim iPreRow
    Dim iRows
    Dim objRange
    
    iRows = 0
    
    For Each objRange In Selection
        iPreRow = iRow
        iRow = objRange.Row
        If (iPreRow <> iRow) Then
            iRows = iRows + 1
        End If
    Next
    
    getSelectionLineCount = iRows
End Function

'// 貼り付けテキスト行数取得
Private Function getPasteTextLineCount()
    Dim v As Variant
    Dim s
    s = txtPaste.Text

    v = Split(s, vbCrLf)
    getPasteTextLineCount = UBound(v)
End Function

100

101

102

103

104

105

106

107

108

Option Explicit

'// クリアボタン

Private Sub cmdClear_Click()

txtPaste.Text = ""

End Sub

'// 貼り付けボタンクリック

Private Sub cmdPaste_Click()

Dim ar As Variant

ReDim ar(0)

'// テキストボックスの内容を取得

Call getPasteString(ar)

'// テキストボックスの内容を結合セルに貼り付け

Call setString(ar)

End Sub

'// テキストボックスの内容を配列で取得

Private Sub getPasteString(a_Ar As Variant)

Dim s

Dim v As Variant

s = txtPaste.Text

v = Split(s, vbCrLf)

a_Ar = v

End Sub

'// 結合セルにテキストボックスの内容を貼り付け

Sub setString(a_Ar)

Dim iRow

Dim iCol

Dim objRange

Dim i

Dim iArSize

iRow = ActiveCell.Row

iCol = ActiveCell.Column

i = 0

iArSize = UBound(a_Ar)

For Each objRange In Selection

If i > iArSize Then

Exit For

End If

If (objRange.Column = iCol) Then

ActiveCell.Offset(i, 0).Value = a_Ar(i)

i = i + 1

End If

End Sub

'// フォームがアクティブになったとき

Private Sub UserForm_Activate()

'// 行数表示

Call setLineCount

End Sub

'// フォームにマウスが重なったとき

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

'// 行数表示

Call setLineCount

End Sub

'// 貼り付けテキストが変更されたとき

Private Sub txtPaste_Change()

'// 行数表示

Call setLineCount

End Sub

'// 行数表示

Private Sub setLineCount()

lblCellLineCount.Caption = getSelectionLineCount()

lblPasteLineCount.Caption = getPasteTextLineCount()

End Sub

'// 選択セル行数取得

Private Function getSelectionLineCount()

Dim iRow

Dim iPreRow

Dim iRows

Dim objRange

iRows = 0

For Each objRange In Selection

iPreRow = iRow

iRow = objRange.Row

If (iPreRow <> iRow) Then

iRows = iRows + 1

End If

getSelectionLineCount = iRows

End Function

'// 貼り付けテキスト行数取得

Private Function getPasteTextLineCount()

Dim v As Variant

Dim s

s = txtPaste.Text

v = Split(s, vbCrLf)

getPasteTextLineCount = UBound(v)

End Function

標準モジュールのコード（フォームの呼び出し）

フォームとは別に標準モジュールを追加します。そこに以下のコードを書きます。

これはフォームを呼び出すための関数です。通常はこの関数を実行することでマクロを利用します。

この関数をクイックアクセスツールバーに登録しておけば好きな時にこのフォームを呼び出すことが出来ます。

Sub 結合セルへの貼り付け()
    frmSetStringUnionCell.Show vbModeless
End Sub

Sub 結合セルへの貼り付け()

frmSetStringUnionCell.Show vbModeless

End Sub

使い方

例として、B列からE列が結合されているセルがあるとします。テキストデータを貼り付けたい部分を選択します。ここでは10行選択しています。

この状態で上のフォームを呼び出します。呼び出す場合は標準モジュールで追加した関数（結合セルへの貼り付け()）を呼び出します。先にも書きましたが、クイックアクセスツールバーにフォームを表示する関数を登録しておけばそこから呼び出すことができます。フォーム表示時はセルの選択行数部分に選択行数が表示されます。

テキストボックスにテキストデータをコピペ、もしくは記入します。テキストボックス内での改行はCtrl + Enterで行います。

Pasteボタンを押します。すると選択セル範囲に結合セルも含めてテキストデータが設定されます。なお、セルの選択範囲はPasteボタンを押す前にセルを選択しなおしても構いません。

テキストボックスには選択セル範囲の行数より多く入力されていますが、セル選択範囲部分までを貼り付けます。なお、この例ではテキストボックスの１行目の１文字目のシングルクォーテーション「’」がセルには貼り付けられていないように見えますが、標準セルの「’」を入力したときと同じ動作になるためセルのデータとしては入力されているのですが表示では見えません。シングルクォーテーションを表示したい場合はセルの表示分類を標準から文字列に変更してください。

Clearボタンを押すとテキストボックスの内容を消去します。

ボタンを押した際の「貼り付けますか？」とか「クリアしますか？」とかはうるさくなるので入れてません。必要な方は適宜MsgBox関数でカスタマイズしてください。

マクロの概要

結合セルへの貼り付けはエラーになる

結合セルにテキストデータを貼り付ける方法

フォーム

コード

標準モジュールのコード（フォームの呼び出し）

使い方

関連記事