クリップボード情報を、特定の列に並べ直す ～別解②～

昨日は、クリップボード情報を特定ラベルの列に入力する際、Typeステートメントを使用してみた。
infoment.hatenablog.com
本日は、更なる簡略化に挑戦する。

昨日は、セルに名前を付けて管理してみた。従って、一旦Typeに入れるのではなく、セルの名前を使用してダイレクトに入力させてみる。

また、一旦コピーするのも止めてみる。作戦は、↓こうだ。

1. 転記したい順に、セルを一つずつ選択する。隣接する場合はまとめて選んでも良いが、順番が変わらないよう注意する。
2. 連続して、転記したいセルを選択する。
3. ループで、選択したセルをコレクションに格納する。
4. コレクションの４つ目のアイテムであるセルの行に、１～３番目に選んだセルの値を入力する。

こんな感じだ。

Sub Sample()
    Dim r As Range
    Dim col As Collection
    Set col = New Collection

        For Each r In Selection
            col.Add r
        Next

        Cells(col.Item(4).Row, Range("管理番号").Column) = col.Item(1).Value
        Cells(col.Item(4).Row, Range("住所").Column) = col.Item(2).Value
        Cells(col.Item(4).Row, Range("氏名").Column) = col.Item(3).Value
End Sub

この方式のメリットは、以下の通り。

1. クリップボードを使用しないため、参照設定が不要になる。
2. クリップボードの内容を改行で分割する、などの処理不要。
3. 情報を取得する三つのセルが、不連続で順不同に並んでいても処理可能。

３番目については、こんな感じだ。

昨日よりもまた、スッキリした形になりました。

参考まで。