ライブラリ

fArray_Merge

***************************************************************
2つの配列を結合する(配列の次元数が同じであること)

【引数】Array1 :データ配列(1次元or2次元)
              Array2 :データ配列(1次元or2次元)
              Direction :結合する方向(xlRows=行方向に結合)
***************************************************************

Public Function fArray_Merge(Array1 As Variant, Array2 As Variant, Optional Direction As XlRowCol = XlRowCol.xlRows) As Variant
    
    Dim MergeAry    As Variant
    
    If fArray_IsArray(Array1) = False Then
        MergeAry = Array2
        
    ElseIf fArray_IsArray(Array2) = False Then
        MergeAry = Array1
    
    Else
        
        Dim Row_L1      As Long
        Dim Row_U1      As Long
        Dim Col_L1      As Long
        Dim Col_U1      As Long
        Call fArray_Lbound_Ubound(Array1, Row_L1, Row_U1, Col_L1, Col_U1)
        
        Dim Row_L2      As Long
        Dim Row_U2      As Long
        Dim Col_L2      As Long
        Dim Col_U2      As Long
        Call fArray_Lbound_Ubound(Array2, Row_L2, Row_U2, Col_L2, Col_U2)
        
        Dim Dim_Ary1    As Long
        Dim Dim_Ary2    As Long
        Dim_Ary1 = fArray_DimCount(Array1)
        Dim_Ary2 = fArray_DimCount(Array2)
        
        If Dim_Ary1 <> Dim_Ary2 Then
            Call MsgBox("結合する配列の次元が一致していません", vbCritical)
            Exit Function
        End If
        
        Select Case Dim_Ary1
        
        Case 1
            Dim Row_S   As Long
            Dim Row_E   As Long
            Dim i       As Long
            Dim k       As Long
            
            If Direction = xlRows Then
                
                MergeAry = Array1
                
                Row_S = Row_L1
                Row_E = Row_U1 + (Row_U2 - Row_L2 + 1)
                
                ReDim Preserve MergeAry(Row_S To Row_E)
                
                Row_S = Row_U1 + 1
                k = Row_L2
                For i = Row_S To Row_E
                    MergeAry(i) = Array2(k)
                    k = k + 1
                Next
                
            Else
                
                Row_S = Row_L1
                
                If (Row_U1 - Row_L1) < (Row_U2 - Row_L2) Then
                    Row_E = Row_U1 + ((Row_U2 - Row_L2) - (Row_U1 - Row_L1))
                Else
                    Row_E = Row_U1
                End If
                
                ReDim MergeAry(Row_S To Row_E, Row_S To Row_S + 1)
                
                For i = Row_L1 To Row_U1
                    MergeAry(i, Row_S) = Array1(i)
                Next
                
                Dim Row_Diff    As Long
                Row_Diff = Row_L2 - Row_L1
                For i = Row_L2 To Row_U2
                    MergeAry(i - Row_Diff, Row_S + 1) = Array2(i)
                Next
                
            End If
            
        Case 2
            Dim Col_S   As Long
            Dim Col_E   As Long
            Dim j       As Long
            Dim h       As Long
            
            If Direction = xlRows Then
                
                Row_S = Row_L1
                Row_E = Row_U1 + (Row_U2 - Row_L2 + 1)
                
                Col_S = Col_L1
                If (Col_U1 - Col_L1) < (Col_U2 - Col_L2) Then
                    Col_E = Col_U1 + ((Col_U2 - Col_L2) - (Col_U1 - Col_L1))
                Else
                    Col_E = Col_U1
                End If
                
                ReDim MergeAry(Row_S To Row_E, Col_S To Col_E)
                
                For j = Col_L1 To Col_U1
                    For i = Row_L1 To Row_U1
                        MergeAry(i, j) = Array1(i, j)
                    Next
                Next
                
                Row_S = Row_U1 + 1
                Col_S = Col_L1
                Col_E = Col_U2 - (Col_L2 - Col_L1)
                h = Col_L2
                For j = Col_S To Col_E
                    k = Row_L2
                    For i = Row_S To Row_E
                        MergeAry(i, j) = Array2(k, h)
                        k = k + 1
                    Next
                    h = h + 1
                Next
                
            Else
                
                Row_S = Row_L1
                If (Row_U1 - Row_L1) < (Row_U2 - Row_L2) Then
                    Row_E = Row_U1 + ((Row_U2 - Row_L2) - (Row_U1 - Row_L1))
                Else
                    Row_E = Row_U1
                End If
                
                Col_S = Col_L1
                Col_E = Col_U1 + (Col_U2 - Col_L2 + 1)
                
                ReDim MergeAry(Row_S To Row_E, Col_S To Col_E)
                
                For j = Col_L1 To Col_U1
                    For i = Row_L1 To Row_U1
                        MergeAry(i, j) = Array1(i, j)
                    Next
                Next
                
                Row_S = Row_L1
                Row_E = Row_U2 - (Row_L2 - Row_L1)
                Col_S = Col_U1 + 1
                
                h = Col_L2
                For j = Col_S To Col_E
                    k = Row_L2
                    For i = Row_S To Row_E
                        MergeAry(i, j) = Array2(k, h)
                        k = k + 1
                    Next
                    h = h + 1
                Next
                
            End If
            
        End Select
        
    End If
    
    fArray_Merge = MergeAry
    
End Function

Array   2017/11/21   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください
12月 2020年1月 2月
   1234
567891011
12131415161718
19202122232425
262728293031

ブログ投稿者一覧

年別アーカイブ一覧