ホーム > ライブラリ > Array > fArray_Slice, fArray_Range

ライブラリ

fArray_Slice, fArray_Range

***************************************************************
配列を切り取る
【注意】切り取った配列の要素は, 切り取る場所に合わせている
              例えば{1 to 3}という配列に対して要素2-3(Start=2, End_=3)を切り取った場合、
              戻値の要素は{2 to 3}となる(2次元配列も同様)

【引数】DataAry :データ配列
              Start :切り取る開始位置
              End_:切り取る終了位置(省略時は指定方向のMAX)
              Direction :切り取る方向(xlRows=横方向(1次元), xlColmuns=縦方向(2次元))
【戻値】切り取った配列
***************************************************************


Public Function fArray_Slice(DataAry As Variant, Index As Long, _
                             Optional Direction As XlRowCol = xlRows) As Variant
'※戻り値は常に1次元配列(基本的に2次元配列から、1行or1列単位で切り取る事に使う)
    
    fArray_Slice = prArray_Slice(DataAry, Index, Direction:=Direction, AutoDimdown:=True)
    
End Function

Public Function fArray_Range(DataAry As Variant, Start As Long, End_ As Long, _
                             Optional Direction As XlRowCol = xlRows) As Variant
'※戻り値は常に2次元配列(指定した行or列の範囲で切り取るのに使う)
    
    fArray_Range = prArray_Slice(DataAry, Start, End_, Direction, AutoDimdown:=False)
    
End Function

Private Function prArray_Slice(DataAry As Variant, Start As Long, _
                               Optional End_ As Variant, _
                               Optional Direction As XlRowCol = xlRows, _
                               Optional AutoDimdown As Boolean = False) 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)
    If (CntDim = 1 Or CntDim = 2) = False Then Exit Function
    
    Dim Idx_S   As Long
    Dim Idx_E   As Long
    Idx_S = Start
    Idx_E = IIf(IsMissing(End_), Start, End_)
    If (Idx_S <= Idx_E) = False Then Exit Function
    
    Dim Row_S       As Long
    Dim Row_E       As Long
    Dim Col_S       As Long
    Dim Col_E       As Long
    Dim Direct  As XlRowCol
    Direct = IIf(CntDim = 1, xlRows, Direction)
    
    '切り取る方向によって、開始・終了位置の取得
    If Direct = xlRows Then
        Row_S = IIf(Idx_S < Row_L, Row_L, Idx_S)
        Row_E = IIf(Row_U < Idx_E, Row_U, Idx_E)
        If (Row_S <= Row_E) = False Then Exit Function
        Col_S = Col_L
        Col_E = Col_U
    Else
        Col_S = IIf(Idx_S < Col_L, Col_L, Idx_S)
        Col_E = IIf(Col_U < Idx_E, Col_U, Idx_E)
        If (Col_S <= Col_E) = False Then Exit Function
        Row_S = Row_L
        Row_E = Row_U
    End If
    
    Dim SliceAry    As Variant
    Select Case CntDim
    
    'データ配列:1次元
    Case 1
        ReDim SliceAry(Row_S To Row_E)
        
        Dim Row_T   As Long
        For Row_T = Row_S To Row_E
            SliceAry(Row_T) = DataAry(Row_T)
        Next
        
    'データ配列:2次元
    Case 2
        Dim Col_T   As Long
        
        '1次元で返す判定
        If (Row_S = Row_E Or Col_S = Col_E) And (AutoDimdown = True) Then
            
            '1次元配列:行単位
            If Direct = xlRows Then
                
                ReDim SliceAry(Col_S To Col_E)
                
                Row_T = Row_S
                For Col_T = Col_S To Col_E
                    SliceAry(Col_T) = DataAry(Row_T, Col_T)
                Next
                
            '1次元配列:列単位
            Else
                ReDim SliceAry(Row_S To Row_E)
                
                Col_T = Col_S
                For Row_T = Row_S To Row_E
                    SliceAry(Row_T) = DataAry(Row_T, Col_T)
                Next
                
            End If
            
        '2次元配列で返す
        Else
            
            ReDim SliceAry(Row_S To Row_E, Col_S To Col_E)
            
            For Col_T = Col_S To Col_E
                For Row_T = Row_S To Row_E
                    SliceAry(Row_T, Col_T) = DataAry(Row_T, Col_T)
                Next
            Next
            
        End If
        
    End Select
    
    prArray_Slice = SliceAry
    
End Function

Array   2017/11/21   shono

この記事へのコメント

コメントを送る

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