飛び飛びに選択したセルからデータをコピーし、飛び飛びに選択したセルに貼り付ける

For Each NextとDataObjectを利用した簡単なマクロを作ってみました。

目次

飛び飛びに選択したセルのデータをコピーし、飛び飛びに選択したセルに貼り付ける

このように飛び飛びのセルを数字の順に選択し、コピーします。

通常のコピーであれば、下記のようなエラーが表示されますが･･････

下記のマクロを使って、飛び飛びに選択したセルのデータをクリップボードに取り込むことができます。 

Sub 飛び飛びのセルのデータをコピーする()
    Dim myRange As Range
    Dim V As String
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する

    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
        If myRange.Address = myRange.MergeArea(1).Address Then   '結合セルの場合は左上の値のみ取り出す
            V = V & myRange.Value & vbCrLf
        End If
    Next myRange
    
    V = Left(V, Len(V) - 2) '最終行の改行区切りを取り除く（CrLfは2文字）

    myLib.SetText V  '変数の値をDataObjectに格納する
    myLib.PutInClipboard 'DataObjectのデータをクリップボードに格納する

End Sub

次に、下記のように赤丸の数字の順にセルを選択し、データを貼り付けてみます。通常の貼り付けをしようとすると、前述と同じエラーが表示されますが、

下記のマクロを使って、クリップボードのデータを飛び飛びに選択したセルに貼り付けることができます。 

Sub 飛び飛びのセルにデータを貼り付ける()
    'クリップボード内のデータを選択した飛び飛びのセルに貼り付けすることができます
    'データは改行区切りとなっている必要があります
    '結合セルを単一セルのように扱うことができます
    Dim V As Variant
    Dim i As Integer
    Dim a As String
    Dim myRange As Range
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する

    myLib.GetFromClipboard
        On Error Resume Next
    V = myLib.GetText
        On Error GoTo 0

    If Not IsEmpty(V) Then
        V = Split(CStr(V), vbCrLf)
        i = 0
        
        For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
            If i <= UBound(V) Then
                If myRange.Address = myRange.MergeArea(1).Address Then   '結合セルの場合は左上のセルにのみ処理を行う
                    a = CStr(V(i))
                    myRange = a
                    i = i + 1   '配列の次の添え字を作成
                End If
            Else
                Exit For    '配列の添え字が最大値を超えたらFor Eachを抜ける
            End If
        
        Next myRange

    Else
        MsgBox "クリップボードにデータがありません！"

    End If
    
End Sub

このように、選択した順に飛び飛びのセルにデータを貼り付けることができました。

クリップボードを一旦経由しているので、同じSheet内だけでなく、別のSheet、別のBookにも貼り付けすることができます。

 コードの説明

やっていることは簡単で、ざっくりいうと、
コピーのマクロ

• 選択したセルからFor Each Nextでデータを順次取り込み、クリップボードに転送

 貼り付けのマクロ

• クリップボードのデータを配列に格納
• 選択したセルに、For Each Nextで配列のデータが無くなるまで入れていく（配列のデータが無くなれば、For Each Nextの途中でも終了。同じようにFor Each Nextが終了すれば、配列のデータが残っていても終了）

処理の途中にある、If myRange.Address = myRange.MergeArea(1).Address Thenの条件分岐は、結合セルの場合は左上のセルにのみ処理を行う（つまりデータが入っているセル、またはデータが入るべきセル）ということを意味しています。

結合セルの場合は左上のセルにのみ処理を行う、という特性を組み合わせて次のように応用することもできます。

応用１：結合セルからデータをコピーし、単一セルにデータを貼り付ける

下図の左側の結合セル群を数字の順に選択してコピーしておき、右側の単一セル群に矢印のような任意の順に、貼り付けることができます。

応用２：単一セルからデータをコピーし、結合セルにデータを貼り付ける

前項の逆です。下図の左側の単一セル群を数字の順に選択してコピーしておき、右側の結合セル群に矢印のような任意の順に、貼り付けることができます。

応用３：表内のデータを好きなように並び替える

下図の表を数字の順に選択してコピーしておきます。

同じ表内で矢印の順に選択して、

貼り付けを行います。これで任意の順にデータが並び変わりました。

For Each Nextの処理の順番

For Each NextでRangeを処理すると、セルを選択した順に処理が行われます。しかし、それは「Ctrl」キーを押しながら順に選択した場合であり、矩形選択（正方形・長方形の形に左上から右下へ、右上から左下へ、左下から右上へ、右下から左上へ選択）した場合は、処理の順番が必ず左上から右へ、1行下がって左から右へ（右下までその繰り返し）になるようです。