不連続な範囲の値を取得 の続き

昨日は或る要望に応え、飛び石のように不連続に散らばった範囲について、その値を取得（集約）する関数を作成してみました。

infoment.hatenablog.com

やれやれ、これで何とかなりそうだ。
そう思ったのも束の間、要望者から新たな要件が告げられたのでした。

「すみません、実は、ここに書いてある内容は２個で１セットなんです」

つまり実際のデータは、こんな感じだったのです。

セルが結合されたり、１行１データレコードになっていなかったりなど、データの再利用を著しく阻害する作りになっています。もともと「見やすさ」重視のレイアウトなので、仕方ないことかもしれませんが。というわけで今回は一次元配列ではなく、複数行２列の二次元配列にする必要があったわけです。

そこで気を取り直して、昨日のマクロを次のように修正しました。

Public Function ConvRangeToArray(myRng As Range) As Variant
    Dim r 　As Range
    Dim col As Collection
        Set col = New Collection
        For Each r In myRng
            col.Add r.Value
        Next
    
    Dim seq  As Variant
    Dim iMax As Long
        iMax = col.Count / 2
        ReDim seq(1 To iMax, 1 To 2)
    
    Dim i As Long, j As Long, k As Long
        k = 1
        For i = 1 To iMax
            For j = 1 To 2
                seq(i, j) = col.Item(k)
                k = k + 1
            Next
        Next
    
    ConvRangeToArray = seq
End Function

昨日の内容を一部変更し、一旦コレクションに格納したものを、二次元配列に編み直しています。試してみたところ、上手くいきました。

Sub test()
    Dim seq As Variant
    seq = ConvRangeToArray(Selection)
    ArrayPaste Range("H3"), seq
End Sub

なお、配列の貼り付けには、以前紹介した関数を使用しています。

infoment.hatenablog.com

やれやれ、これで何とかなりそうだ。
「こんな感じでどうです？」
「ありがとうございます＾＾。ほとんどの場合は、これでＯＫです！」

え・・・ほとんどの場合？

更に次回に続く（かもしれない）。

参考まで。