選択した範囲の内、非表示の列を含まない範囲の値を配列に格納したい ②

f:id:Infoment:20190725223432p:plain

前回、このようなテーマに挑戦した。
infoment.hatenablog.com

最終的に求める結果は得られたものの、単に値を地道に配列へ放り込むことしか
できず、消化不良の感があった。

その後探すも時間が無く、探し方も悪いのか、スマートな解決策は得られず。
ということで安易に、今まで作った関数の組合せで解決することにした。

取り敢えず、選択範囲を配列に格納する。
選択範囲の各列について、非表示ではない列数でコレクションを作成。
コレクションを配列に変換（自作のToArray）
最初に取得した配列から、３．を用いて非表示ではない列のみ抽出（自作のExtractArray）

なお、１～４は全て、今までにも何度か登場した「SeaquenceClass」で一つに
まとめてある。

クラスモジュール（SeaquenceClass）

Public Function ToArray(col As Collection) As Variant
    Dim arr As Variant
    ReDim arr(col.Count - 1)
    Dim C As Variant
    Dim i As Long
        i = 0
        For Each C In col
            arr(i) = C
            i = i + 1
        Next
    ToArray = arr
End Function

'［用　途］
'   指定範囲から、指定列番号のみ抽出した配列を作成
'   ※指定範囲は、配列を指定可能

'［引　数］
'   target_data          As Variant　抽出対象となる範囲
'   extract_column_array As Variant  抽出される列情報（配列）
'   例）1,3,5列目を抜き出す ⇒ extract_column_array = Array(1,3,5)
'       ※0列目を指定すると、空白列が挿入される。

'［戻り値］
'   配列の場合  正常終了
'   -1の場合    異常終了　extract_column_arrayの指定が不適切
'   -2の場合    異常終了　target_dataが範囲または配列以外
'   -3の場合    異常終了  抽出指定が元データの範囲を超えている

Public Function ExtractArray(target_data As Variant, _
                             extract_column_array As Variant) As Variant

    ' 抽出列の指定方法確認。
        If GetArrayDimension(extract_column_array) <> 1 Then
            ExtractArray = -1: Exit Function
        End If

    ' 抽出対象が範囲または配列以外の場合は処理中断。
        If TypeName(target_data) = "Range" Then
            If target_data.Rows.Count = 1 Or target_data.Columns.Count = 1 Then
                ExtractArray = target_data
                Exit Function
            End If
        ElseIf IsArray(target_data) = False Then
            ExtractArray = -2: Exit Function
        End If

    Dim DataArr As Variant
        DataArr = target_data

    ' 抽出列が抽出対象の範囲を超えている場合、処理を中断。
        If UBound(DataArr, 2) < extract_column_array(UBound(extract_column_array)) Then
            ExtractArray = -3: Exit Function
        End If

    ' 抽出後の配列定義。
    Dim rMax As Long
        rMax = ArrRowsAndColumnsCount(DataArr, 1)
    Dim cMax As Long
        cMax = ArrRowsAndColumnsCount(extract_column_array, 1)

    Dim TempArray As Variant
    ReDim TempArray(1 To rMax, 1 To cMax)

    ' 抽出後の配列作成。
    Dim R As Long
    Dim C As Long
    Dim i As Long
        i = 0
        For C = 1 To cMax
            For R = 1 To rMax
                If extract_column_array(i) > 0 Then
                    TempArray(R, C) = DataArr(R, extract_column_array(i))
                End If
            Next
            i = i + 1
        Next

        ExtractArray = TempArray
End Function

'［用　途］
'   配列の次元数取得
'
'［引　数］
'   arr As Variant  配列
'
'［戻り値］
'   正常終了    配列の次元数
'   -1の場合    異常終了　※つまり、seqは配列ではない

Private Function GetArrayDimension(arr As Variant) As Long
    If IsArray(arr) = False Then
        GetArrayDimension = -1
        Exit Function
    End If

    ' 配列の次元数を取得。
    Dim i As Long
    Dim TempNumber As Long

        On Error Resume Next
        Do While Err.Number = 0
            i = i + 1
            TempNumber = UBound(arr, i)
        Loop

        GetArrayDimension = i - 1
End Function

'［用　途］
'   配列の指定インデックスの数を取得
Private Property Get ArrRowsAndColumnsCount(target_array As Variant, _
                                            rc_index As Long) As Long

    ArrRowsAndColumnsCount = UBound(target_array, rc_index) - LBound(target_array, rc_index) + 1
End Property

以上を踏まえたうえで、今回作成したのがこちら。

Function GetArrayFromVisibleRange(target_range As Range) As Variant
    Dim arr() As Variant
        arr = target_range
    Dim col As Collection
    Set col = New Collection
    Dim i As Long
        For i = 1 To target_range.Columns.Count
            If target_range.Columns(i).Hidden = False Then
                col.Add i
            End If
        Next

        arr = ExtractArray(arr, ToArray(col))

        GetArrayFromVisibleRange = arr
End Function

ここまで準備すれば、標準モジュール側は、実にスッキリしたものとなる。

標準モジュール

Sub Test()
    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
    
    Dim arr() As Variant
        arr = SQC.GetArrayFromVisibleRange(Selection)
End Sub