【VBA】2次元配列の要素追加

#VBA
'2次元配列の要素追加
Function AddItemsArray( _
             ByRef varArray As Variant _
           , Optional ByRef AddRows As Integer _
           , Optional ByRef AddColumns As Integer _
       ) As Boolean
   On Error GoTo Catch
   
   Dim temp() As Variant
   Dim i As Integer
   Dim j As Integer
   
   '配列判定
   If IsArray(varArray) = False Then
       AddItemsArray = False
       Debug.Print "受け取ったデータが配列ではありません"
       GoTo Finally
   End If
   
   '追加要素数判定
   If AddRows = 0 And AddColumns = 0 Then
       AddItemsArray = False
       Debug.Print "追加要素がありません"
       GoTo Finally
   End If
   
   '次元数確認
   On Error Resume Next
   While Err.Number = 0
       i = i + 1
       j = UBound(varArray, i)
   Wend
   On Error GoTo Catch
   If i - 1 <> 2 Then
       AddItemsArray = False
       Debug.Print "2次元データを指定してください。取得データ:" & i - 1 & "次元"
       GoTo Finally
   End If
   
   '行追加
   If AddRows > 0 Then
       temp = WorksheetFunction.Transpose(varArray)    '配列の行列を入れ替える
       ReDim Preserve temp(UBound(temp, 1) _
                         , UBound(temp, 2) + AddRows)  '行追加
       varArray = WorksheetFunction.Transpose(temp)    '配列の行列を戻す
   End If
   
   '列追加
   If AddColumns > 0 Then
       ReDim Preserve temp(UBound(temp, 1) _
                     , UBound(temp, 2) + AddColumns)  '列追加
   End If

   AddItemsArray = True
   
   GoTo Finally
Catch:
   AddItemsArray = False
   Debug.Print "■エラー【AddItemsArray】" & vbCrLf & Err.Number & vbTab & Err.Description
Finally:
End Function


いいなと思ったら応援しよう!