0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

配列をいじる系のVBA(ソート、フィルター、削除、定義)

Last updated at Posted at 2022-10-16

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

'''
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?