ライブラリ

fArray_DimDown

***************************************************************
配列の次元数を下げる(2次元配列を1次元配列にする)

【引数】DataAry :データ配列
              Direction :1次元に結合する時の方向(xlRows=1行毎に結合する)
***************************************************************

Public Function fArray_DimDown(DataAry As Variant, Optional Direction As XlRowCol = xlRows) As Variant
'- 2次元配列(Range.Value等)を1次元配列にする
    
    Dim Array1      As Variant
    
    Dim Row_L   As Long
    Dim Row_U   As Long
    Dim Col_L   As Long
    Dim Col_U   As Long
    Call fArray_Lbound_Ubound(DataAry, Row_L, Row_U, Col_L, Col_U)
    
    Dim CntDim  As Long
    CntDim = fArray_DimCount(DataAry)
    Select Case CntDim
    
    Case 1
        Array1 = DataAry
        
    Case 2
        Dim i           As Long
        Dim j           As Long
        Dim Cnt_Row     As Long
        Dim Cnt_Col     As Long
        Cnt_Row = UBound(DataAry, 1) - LBound(DataAry, 1) + 1
        Cnt_Col = UBound(DataAry, 2) - LBound(DataAry, 2) + 1
        
        '- 1列だけの場合
        If Cnt_Col = 1 Then
            
            ReDim Array1(Row_L To Row_U)
            
            For i = Row_L To Row_U
                Array1(i) = DataAry(i, Col_L)
            Next
            
        '- 1行だけの場合
        ElseIf Cnt_Row = 1 Then
            
            ReDim Array1(Col_L To Col_U)
            
            For i = Col_L To Col_U
                Array1(i) = DataAry(Row_L, i)
            Next
        
        Else
            Dim LineAry     As Variant
            
            '- 行方向に一次元配列に変換する
            If Direction = xlRows Then
                
                ReDim Array1(Row_L To Row_U)
                ReDim LineAry(Col_L To Col_U)
                
                For i = Row_L To Row_U
                    For j = Col_L To Col_U
                        LineAry(j) = DataAry(i, j)
                    Next
                    Array1(i) = LineAry
                Next
                
            '- 列方向に一次元配列に変換する
            Else
                
                ReDim Array1(Col_L To Col_U)
                ReDim LineAry(Row_L To Row_U)
                
                For j = Col_L To Col_U
                    For i = Row_L To Row_U
                        LineAry(i) = DataAry(i, j)
                    Next
                    Array1(j) = LineAry
                Next
                
            End If
            
        End If
        
    End Select
    
    fArray_DimDown = Array1
    
End Function

Array   2017/11/21   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください