.NET FrameworkのArrayListクラスを使ったVBAの新しい可能性とArrayList自作

Sub UseArrayList()
    ' ArrayListクラスのインスタンスを作成
    Dim myList As Object
    Set myList = CreateObject("System.Collections.ArrayList")
    
    ' ランダムな数値を配列に格納
    Dim i As Integer
    For i = 1 To 10
        myList.Add Int((100 * Rnd) + 1)
    Next i
    
    ' 配列をソート
    myList.Sort
    
    ' 配列を逆順にする
    myList.Reverse
    
    ' 配列を複製
    Dim myCopy As Object
    Set myCopy = myList.Clone
    
    ' 結果の表示
    MsgBox "元の配列: " & Join(myList.ToArray, ", ") & vbCrLf & _
           "複製した配列: " & Join(myCopy.ToArray, ", ")
End Sub

' ArrayList.cls

Private values As Collection

Public Sub Initialize()
    Set values = New Collection
End Sub

Public Sub Add(item As Variant)
    values.Add item
End Sub

Public Function Get(index As Integer) As Variant
    If index >= 1 And index <= values.Count Then
        Get = values(index)
    Else
        Err.Raise 9, "ArrayList", "Index out of bounds"
    End If
End Function

Public Function Count() As Integer
    Count = values.Count
End Function

Sub TestArrayList()
    Dim myList As New ArrayList
    
    ' データの追加
    myList.Add "John"
    myList.Add 25
    myList.Add "Alice"
    myList.Add 30
    myList.Add "Bob"
    myList.Add 22
    
    ' データの表示
    DisplayArrayList myList
End Sub

Sub DisplayArrayList(arrList As ArrayList)
    Dim i As Integer
    For i = 1 To arrList.Count
        Debug.Print arrList.Get(i)
    Next i
End Sub

' ArrayList.cls

Private values As Collection

Public Sub Initialize()
    Set values = New Collection
End Sub

Public Sub Add(item As Variant)
    values.Add item
End Sub

Public Function Get(index As Integer) As Variant
    If index >= 1 And index <= values.Count Then
        Get = values(index)
    Else
        Err.Raise 9, "ArrayList", "Index out of bounds"
    End If
End Function

Public Function Count() As Integer
    Count = values.Count
End Function

Public Sub Clear()
    Set values = New Collection
End Sub

Public Function ToArray() As Variant
    Dim result() As Variant
    ReDim result(1 To values.Count)
    
    Dim i As Integer
    For i = 1 To values.Count
        result(i) = values(i)
    Next i
    
    ToArray = result
End Function

Public Function To2DArray() As Variant
    Dim result() As Variant
    ReDim result(1 To values.Count, 1 To 1)
    
    Dim i As Integer
    For i = 1 To values.Count
        result(i, 1) = values(i)
    Next i
    
    To2DArray = result
End Function

Sub TestArrayList()
    Dim myList As New ArrayList
    
    ' データの追加
    myList.Add "John"
    myList.Add 25
    myList.Add "Alice"
    myList.Add 30
    myList.Add "Bob"
    myList.Add 22
    
    ' データの表示
    DisplayArrayList myList
    
    ' 2次元配列に変換して表示
    Display2DArray myList.To2DArray
End Sub

Sub DisplayArrayList(arrList As ArrayList)
    Dim i As Integer
    For i = 1 To arrList.Count
        Debug.Print arrList.Get(i)
    Next i
End Sub

Sub Display2DArray(arr As Variant)
    Dim i As Integer, j As Integer
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            Debug.Print arr(i, j)
        Next j
    Next i
End Sub

Public Sub Insert(index As Integer, item As Variant)
    If index >= 1 And index <= values.Count + 1 Then
        values.Add item, , index
    Else
        Err.Raise 9, "ArrayList", "Index out of bounds"
    End If
End Sub

Public Sub Remove(index As Integer)
    If index >= 1 And index <= values.Count Then
        values.Remove index
    Else
        Err.Raise 9, "ArrayList", "Index out of bounds"
    End If
End Sub

Public Function IndexOf(item As Variant) As Integer
    On Error Resume Next
    IndexOf = values.Item(item)
    On Error GoTo 0
End Function

Public Function Contains(item As Variant) As Boolean
    Contains = (IndexOf(item) > 0)
End Function

Public Function GetRange(startIndex As Integer, count As Integer) As ArrayList
    If startIndex >= 1 And startIndex <= values.Count Then
        Dim result As New ArrayList
        Dim i As Integer
        For i = startIndex To startIndex + count - 1
            result.Add values(i)
        Next i
        Set GetRange = result
    Else
        Err.Raise 9, "ArrayList", "Invalid start index"
    End If
End Function

Public Sub Sort(Optional descending As Boolean = False)
    Dim tempArray() As Variant
    tempArray = ToArray()
    If descending Then
        Call VBA.Sort(tempArray, Array:=Array(1, 2), Order:=xlDescending)
    Else
        Call VBA.Sort(tempArray, Array:=Array(1, 2))
    End If
    Clear
    Dim i As Integer
    For i = LBound(tempArray) To UBound(tempArray)
        Add tempArray(i, 1)
    Next i
End Sub

Public Sub ForEach(callback As String)
    Dim i As Integer
    For i = 1 To values.Count
        Application.Run callback, values(i)
    Next i
End Sub

Public Function Clone() As ArrayList
    Dim clonedList As New ArrayList
    Dim i As Integer
    For i = 1 To values.Count
        clonedList.Add values(i)
    Next i
    Set Clone = clonedList
End Function

Public Function ToString() As String
    Dim result As String
    Dim i As Integer
    For i = 1 To values.Count
        result = result & values(i) & ", "
    Next i
    If Len(result) > 0 Then
        result = Left(result, Len(result) - 2)
    End If
    ToString = "[" & result & "]"
End Function

Public Function Map(callback As String) As ArrayList
    Dim result As New ArrayList
    Dim i As Integer
    For i = 1 To values.Count
        result.Add Application.Run(callback, values(i))
    Next i
    Set Map = result
End Function

Public Function Filter(callback As String) As ArrayList
    Dim result As New ArrayList
    Dim i As Integer
    For i = 1 To values.Count
        If Application.Run(callback, values(i)) Then
            result.Add values(i)
        End If
    Next i
    Set Filter = result
End Function

Public Function Flatten() As ArrayList
    Dim result As New ArrayList
    Dim i As Integer
    For i = 1 To values.Count
        If TypeName(values(i)) = "ArrayList" Then
            Dim subList As ArrayList
            Set subList = values(i)
            Dim j As Integer
            For j = 1 To subList.Count
                result.Add subList.Get(j)
            Next j
        Else
            result.Add values(i)
        End If
    Next i
    Set Flatten = result
End Function

Public Sub WriteToWorksheet(targetWorksheet As Worksheet, Optional startCell As Range)
    Dim targetRange As Range
    If startCell Is Nothing Then
        Set targetRange = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Else
        Set targetRange = startCell
    End If

    Dim i As Integer
    For i = 1 To values.Count
        targetRange.Offset(i - 1, 0).Value = values(i)
    Next i
End Sub

Public Sub ReadFromWorksheet(sourceWorksheet As Worksheet, sourceRange As Range)
    Dim sourceData As Variant
    sourceData = sourceRange.Value

    Dim i As Integer
    For i = LBound(sourceData, 1) To UBound(sourceData, 1)
        Add sourceData(i, 1)
    Next i
End Sub