不連続な範囲の値を取得

連続しない複数の範囲から、値を取得(集約)したいという要望がありました。
例えば、こんな感じです。数字が入力されたセルが、値の集約対象範囲です。

f:id:Infoment:20180718230747p:plain

同範囲を選択した状態でコピーしようとすると、エラーになります。

f:id:Infoment:20180718231608p:plain

今は便宜上、対象範囲の値を数字にしていますが、実際は様々な値が入力されています。従って、「数字が入っているセルから値を取得」のようなことが出来ません。

皆さんなら、どうされるでしょうか。正解は、一つではありません。興味のある方は一旦ここで読むのを止めて、自分なりの解決法を探ったり、あるいは過去に行った方法を思い返すのも面白いと思います。出来れば色々と議論しながら進められたら楽しいのですが、とりあえず私は以下のように考えてみました。

そのまま配列に格納できないか

試しに、選択範囲を配列に格納して、ウォッチウィンドウで確認してみました。

Sub test()
    Dim seq As Variant
    seq = Selection
End Sub

結果は、最初のグループしか取得できていませんでした。

f:id:Infoment:20180718232541p:plain

Areasプロパティを用いれば上手くいくのかもしれませんが、単純な配列への格納は、
一旦断念しました。

For Next ループで値を取得できないか

次に、単純に選択範囲でループさせて値を取得できないか、試してみました。

Sub test()
    Dim r As Range
    For Each r In Selection
        Debug.Print r.Value
    Next
End Sub

結果、選択範囲が不連続であっても、全ての選択範囲から値を取得できました。

f:id:Infoment:20180718233546p:plain

これなら、上手くいきそうです。

改めて配列に格納してみる

今回は値の集約が目的ですから、書式を維持する必要がありません。そこで取得した値を配列化しておけば、扱い易いと考えました。

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 i   As Long
    
    ReDim seq(1 To col.Count)
    For i = 1 To col.Count
        seq(i) = col.Item(i)
    Next
    
    ConvRangeToArray = seq
End Function

一旦コレクションに溜め込んでいるのは、単なる好みです。選択範囲を数えたり、配列の大きさを逐次拡張してもOKです。

結果、上手く取得できました。

Sub test()
    MsgBox Join(ConvRangeToArray(Selection), vbLf)
End Sub

f:id:Infoment:20180718235928p:plain

やれやれ、これで何とかなりそうだ。
そう思ったのも束の間、要望者から新たな要件が告げられたのでした。
「すみません、実は・・・」

次回に続く(かもしれない)。

参考まで。