【VBA】楽なコピペをめざして ～セル結合へのテキスト情報入力～

どうも、バグです。 今回、なぜかVBAのものが完成してたので、備忘録として記事を書きます。

目的

週末にエクセルをイジる機会があったんですが、コピペをした際にエラーではじかれました。 はい、皆さんダイスキ、セル結合です。 ……えっ、一行ごとにセル結合しているの？ いちいち皆、解除しながら作業しているの？めんどくない？ という思いもあって、タイミングよく以下のTogetterも公開されて、「やってみるしかないよな～」という気持ちで作成。 VBAerなら、セル範囲の指定が面白いと思うのでぜひともおすすめです。

ワクワクV036回目レンジのグループと組み合わせ方（ほえほえ@hoehoe1234さんまとめ） togetter.com

なので、今回のマクロは、「複数のセル結合している範囲に対して、コピーしてきたテキスト情報を出力、再結合」が目的となってます。

環境

Office365

処理概要

処理概要フロー
1. クリップボードからテキスト情報を配列で取得
2. エラー判定（選択範囲より大きいテキスト情報を格納していないかチェック）
3. 入力対象のセルの結合解除、テキスト入力、再結合

動作イメージ

動作としては、以下の通りとなります。
①結合セルを選択し、マクロ登録したボタンをクリック！

結合セルを選択し、隣のセルをコピペする

②コピーしていたテキスト情報が、結合セルの中に入力されます。なおかつ、結合もそのままです。

結合セルに、結合状態を維持したままテキスト情報が 入力

③もし、コピーしたテキストが、選択範囲よりも大きい場合

もし、テキスト情報が選択範囲よりも多い場合

④下の画面のようにエラーを返します。

もし、テキスト情報が選択範囲よりも多い場合エラーを返します

ソース

▶クリックで展開

Sub f_Stream_FromClipboard_ToMergedcells()
'@function: 結合セルへのテキスト結合
'@param   : クリップボードのテキスト情報
'@param   : 結合セルの選択
'@注意事項
'    *1 テキスト行より、小さい範囲には貼り付けできません。
'    *2 行方向にテキスト貼り付けをします。複数列にはテキスト貼り付けできません。
'    *3 マクロなので、Undo機能が無効化されます。誰かマクロ実行前のUndo履歴を保持する方法を教えてください。

'処理概要フロー
'   １．クリップボードからテキスト情報を配列で取得
'   ２．エラー判定（選択範囲より大きいテキスト情報を格納していないかチェック）
'   ３．入力対象のセルの結合解除、テキスト入力、再結合
    
    Dim CB As New DataObject 'クリップボード
    Dim txt_clip As Variant  'クリップボードが保持するテキスト情報(配列)  ＊１．インデックス＝0始まり
    Dim cnt_line             'テキスト情報の行数
    
    
'１．クリップボードからテキスト情報を取得
    With CB
        .GetFromClipboard
        txt_clip = Split(CB.GetText, vbCrLf, , vbBinaryCompare)
    End With
    cnt_line = UBound(txt_clip) + 1
    
    
'２．エラー判定（選択範囲より大きいテキスト情報を格納していないかチェック）

    Dim tmp_count_row: tmp_count_row = 0    ' 選択範囲の行数カウント（.Rows.Countでは結合が解除された状態でカウントされるため）
    Dim tmp_area As Range                   ' 結合セルの起点セル
        
    ' 選択範囲の行数カウント
    Set tmp_area = Selection.Cells(1, 1)
    
    '【条件式】
    '   @if 行を回して、選択範囲からはみ出るまで実行
    '   @if_True 行数カウント
    '【コラム】
    'Set tmp_area = tmp_area.Offset(1, 0)は結合セル対応のため
    Do Until (Application.Intersect(Selection, tmp_area.Rows(1).Cells(1).MergeArea) Is Nothing)
        tmp_count_row = tmp_count_row + 1
        Set tmp_area = tmp_area.Offset(1, 0)
    Loop
    
    ' エラー判定（選択範囲より大きいテキスト情報を格納していないか）
    ' -------------------------------------------------------------------------------
    '【エラー判定式】
    '   @err_if 選択範囲より大きいテキスト情報を格納していないか？
    '   @err_if_True(テキスト情報の方が大きい) 処理の終了
    If tmp_count_row < cnt_line Then
        MsgBox "選択範囲よりもクリップボードの情報が大きいです。選択範囲またはテキスト情報を修正してください。"
        Exit Sub
    End If
    
'３．入力対象のセルの結合解除、テキスト入力、再結合

    Dim x As Range        ' 分割後のテキスト入力セルを示す一時変数
    Dim idx: idx = 0      ' テキスト情報の配列要素を示す一時変数
    Dim tmp_merge_area    ' セル結合解除前にアドレス範囲を退避させる一時変数
    
    '【条件式】
    '   @for テキスト情報が最大要素数まで出力するまで
    Set x = Selection.Offset(0, 0).Cells(1, 1).MergeArea
    For idx = 0 To cnt_line - 1
        '  結合範囲の退避
        tmp_merge_area = x.Address
        x.UnMerge
        x.Cells(1).Value = txt_clip(idx)
        Range(tmp_merge_area).merge
        Set x = x.Offset(1, 0).Cells(1, 1).MergeArea
    Next
    
End Sub

今後の課題

……ソースの乗っけ方わかりません……？ なんかコメントが外れたりしてます？？？

なんか……もっと勉強してきます。

後、VBAに関しては、このソース、 テキスト情報をコピーしないとエラー停止してしまうので、そこは大きな課題ですね。

あと、Undo機能をちゃんと搭載できれば、普通に [Ctrl] + [V] で結合セルか判断して実行できるので有益なんだけどな(´・ω・｀)

このブログは後編みたいな形で一応の解説をつけるつもりです。 もし、質問があればコメントいただけると幸いです。（文章読みづらいでも可）