#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