Transpose関数を利用
Option Base 1
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
'★2次元配列の1次元目の要素数を増やす (Transpose利用)
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
Public Function zfRedimPreserveArray(ByVal arr As Variant, ByVal rowNum As Long)
Dim tempArr() As Variant
tempArr = WorksheetFunction.Transpose(arr)
ReDim Preserve tempArr(UBound(tempArr, 1), rowNum)
zfRedimPreserveArray = WorksheetFunction.Transpose(tempArr)
End Function
Public Function zfRedimPreserveArray2(ByVal arr As Variant, ByVal rowNum As Long)
Dim tempArr() As Variant
Dim i As Long
If rowNum = 1 Then
ReDim tempArr(1, UBound(arr, 2))
For i = 1 To UBound(arr, 2)
tempArr(1, i) = arr(1, i)
Next i
zfRedimPreserveArray = tempArr
Else
tempArr = WorksheetFunction.Transpose(arr)
ReDim Preserve tempArr(UBound(tempArr, 1), rowNum)
zfRedimPreserveArray = WorksheetFunction.Transpose(tempArr)
End If
End Function
一時保管用配列を利用
===============================================================
' 任意の行数で配列を縮小 (手動ループ)
'===============================================================
Public Function zfRedimPreserveArray2(ByVal arr As Variant, ByVal newRowCount As Long) As Variant
Dim tempArr() As Variant
Dim i As Long, j As Long
Dim maxRow As Long, maxCol As Long
maxRow = UBound(arr, 1)
maxCol = UBound(arr, 2)
If newRowCount < 1 Or newRowCount > maxRow Then
Err.Raise vbObjectError + 1, , "指定した行数が不正です"
End If
ReDim tempArr(1 To newRowCount, 1 To maxCol)
For i = 1 To newRowCount
For j = 1 To maxCol
tempArr(i, j) = arr(i, j)
Next j
Next i
zfRedimPreserveArray2 = tempArr
End Function
Transpose関数と手動ループの違い
方法 | 安全性 | 高速性 | 実用性 |
---|
Transpose を使う | △ | ◎ | ×(65536超NG) |
手動ループで縮小 | ◎ | ◯ | ◎(大量データOK) |
コメント