VBAで配列を操作する系の関数を4つ作成しました。
・二次元配列系
① 二次元配列をバブルソートする(ArraySort)
② 二次元配列にフィルターをかける(ArrayFilter)
・一次元配列系
③ 配列の特定の行を削除する(ArrayRemove)
③ 一次元配列を定義する(ArrayDefinition)
すべてOption Base 1で作成しています。
これによって配列は1から始まります。
関数の実行方法は以下のようになります。
① ArraySort(二次元配列, ソートしたい列, 昇順 or 降順)
② ArrayFilter(二次元配列, フィルターをかけたい列, 限界値, 大なり or 小なり)
③ ArrayRemove(元の配列, 削除したい行(配列で定義))
④ ArrayDefinition(パラメータを記述)
ArrayFunctions.bas
Option Base 1
Public Function ArraySort(arr As Variant, OrderCol As Long, AscendingOrder As Boolean)
' Option Base 1 is necessary.
' OrderCol : The sorting criteria column
' AscendingOrder : true = ascending, false = descending
Dim i As Long, j As Long
Dim finFlg As Boolean
Dim temp() As Variant
ReDim temp(1, UBound(arr, 2))
Do
finFlg = True
For i = 1 To UBound(arr, 1) - 1
Select Case AscendingOrder
Case True 'ascending order
If arr(i, OrderCol) > arr(i + 1, OrderCol) Then
finFlg = False
For j = 1 To UBound(arr, 2)
temp(1, j) = arr(i, j)
Next j
For j = 1 To UBound(arr, 2)
arr(i, j) = arr(i + 1, j)
Next j
For j = 1 To UBound(arr, 2)
arr(i + 1, j) = temp(1, j)
Next j
End If
Case False 'descending Order
If arr(i, OrderCol) < arr(i + 1, OrderCol) Then
finFlg = False
For j = 1 To UBound(arr, 2)
temp(1, j) = arr(i, j)
Next j
For j = 1 To UBound(arr, 2)
arr(i, j) = arr(i + 1, j)
Next j
For j = 1 To UBound(arr, 2)
arr(i + 1, j) = temp(1, j)
Next j
End If
End Select
Next i
Loop While Not (finFlg)
End Function
Public Function ArrayFilter(arr As Variant, OrderCol As Double, limit As Double, Order As Boolean) As Variant
Dim temp() As Variant
Dim arrExport() As Variant
Dim i As Integer
Dim j As Integer
Dim cnt As Integer
cnt = 0
rownum = UBound(WorksheetFunction.Index(arr, 1))
ReDim temp(UBound(arr), rownum)
For i = LBound(arr) To UBound(arr)
Select Case Order
Case True ' >= limit
If arr(i, OrderCol) >= limit Then
cnt = cnt + 1
For j = 1 To rownum
temp(cnt, j) = arr(i, j)
Next
End If
Case False ' < limit
If arr(i, OrderCol) < limit Then
cnt = cnt + 1
For j = 1 To rownum
temp(cnt, j) = arr(i, j)
Next
End If
End Select
Next
ReDim arrExport(cnt, rownum)
For i = 1 To cnt
For j = 1 To rownum
arrExport(i, j) = temp(i, j)
Next
Next
ArrayFilter = arrExport
End Function
Public Function ArrayRemove(arr As Variant, removeRows As Variant) As Variant
Dim i As Integer
Dim j As Integer
Dim arrlength As Integer
Dim temp As Variant
j = 1
temp = arr
arrlength = UBound(removeRows)
For i = LBound(temp) To UBound(temp)
If arrlength > j - 1 Then
If i = temp(removeRows(j)) Then
j = j + 1
Else
temp(i - j + 1) = temp(i)
End If
Else
temp(i - j + 1) = temp(i)
End If
Next i
ReDim Preserve temp(UBound(temp) - j + 1)
ArrayRemove = temp
End Function
Public Function ArrayDefinition(ParamArray arr()) As Variant
Dim arrlength As Integer
Dim temp() As Variant
arrlength = UBound(arr) - LBound(arr) + 1
ReDim temp(1 To arrlength)
For i = LBound(temp) To UBound(temp)
temp(i) = arr(i - 1)
Next
ArrayDefinition = temp
End Function
'''