読者です 読者をやめる 読者になる 読者になる

C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

ArrayListラッパークラスをお借りしてみる2

VBA

こちらの続きです。
ArrayListラッパークラスをお借りしてみる - C#ATIA

イロイロとコメントで教えて頂いたので、こちらの.NETFramework_ArrayList
ラッパークラスに
AarrayListをvbaで使いやすいようにラップしてみた : 趣味のプログラムあれこれ

こちらを反映してみました。
Wrap .Net ArrayList with custom VBA class get iterator - Stack Overflow


ArrayListラッパークラスです。こちらは直接ペーストするとエラーになってしまいます。
一度エクスポートして・・・thomさんのこちらのサイトがわかりやすいかと思います。

VBA 自作のCollectionクラスをFor Eachでまわす裏ワザ - t-hom’s diary

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'vba .NETFramework_ArrayList_Rapper_Class
'http://blog.livedoor.jp/midorityo/archives/50749809.html
'http://stackoverflow.com/questions/25580867/wrap-net-arraylist-with-custom-vba-class-get-iterator
Option Explicit

Private arraylist As Object

Private Sub Class_Initialize()
    Set arraylist = CreateObject("System.Collections.ArrayList")
End Sub

'修正
Private Sub Class_Terminated()
    If Not internalList Is Nothing Then
        On Error Resume Next
        arraylist.Dispose
        Err.Clear
    End If
End Sub

Function Add(ByVal value As Variant) As Long
    Add = arraylist.Add(value)
End Function

Function BinarySearch(ByVal value As Variant, _
                        Optional ByVal conparer As Long = 0, _
                        Optional ByVal Index As Long = -1, _
                        Optional ByVal count As Long = 0) As Long
    Dim rtn As Long
    
    If Index < 0 Then
        If conparer = 0 Then
            rtn = arraylist.BinarySearch_2(value)
        Else
            rtn = arraylist.BinarySearch_3(value, CreateObject("System.Collections.CaseInsensitiveComparer"))
        End If
    Else
        If count < 0 Then count = 0
        If conparer = 0 Then
            rtn = arraylist.BinarySearch(Index, count, value, Nothing)
        Else
            rtn = arraylist.BinarySearch(Index, count, value, CreateObject("System.Collections.CaseInsensitiveComparer"))
        End If
    End If
    BinarySearch = rtn
End Function

Sub Clear()
    arraylist.Clear
End Sub

Function Contains(ByVal Item As Variant) As Boolean
    Contains = arraylist.Contains(Item)
End Function

Function IndexOf(ByVal value As Variant, _
                    Optional startIndex As Long = -1, _
                    Optional count As Long = 0) As Long
    Dim rtn As Long
    
    If startIndex < 0 Then
        rtn = arraylist.IndexOf_3(value)
    Else
        If count < 1 Then
            rtn = arraylist.IndexOf(value, startIndex)
        Else
            rtn = arraylist.IndexOf_2(value, startIndex, count)
        End If
    End If
    IndexOf = rtn
End Function

Sub Insert(ByVal Index As Long, ByVal value As Variant)
    arraylist.Insert Index, value
End Sub

Function LastIndexOf(ByVal value As Variant, _
                Optional ByVal startIndex As Long = -1, _
                Optional ByVal count As Long = 0) As Long
    Dim rtn As Long
    If startIndex < 0 Then
        rtn = arraylist.LastIndexOf(value)
    Else
        If count < 1 Then
            rtn = arraylist.LastIndexOf(value, startIndex)
        Else
            rtn = arraylist.LastIndexOf(value, startIndex, count)
        End If
    End If
    LastIndexOf = rtn
End Function

Sub Remove(ByVal obj As Variant)
    arraylist.Remove (obj)
End Sub

Sub RemoveAt(ByVal Index As Long)
    arraylist.RemoveAt (Index)
End Sub

Sub Reverse(Optional ByVal Index As Long = -1, _
            Optional ByVal count As Long = 0)
    If Index < 0 Then
        arraylist.Reverse
    Else
        If count < 0 Then count = 0
        arraylist.Reverse_2 Index, count
    End If
End Sub

Sub Sort(Optional ByVal comparer As Long = 0, _
            Optional ByVal Index As Long = -1, _
            Optional ByVal count As Long = 0)
    If Index < 0 Then
        If comparer = 0 Then
            arraylist.Sort
        Else
            arraylist.Sort_2 (CreateObject("System.Collections.CaseInsensitiveComparer"))
        End If
    Else
        If comparer = 0 Then
            arraylist.Sort_3 Index, count, Nothing
        Else
            arraylist.Sort_3 Index, count, CreateObject("System.Collections.CaseInsensitiveComparer")
        End If
    End If
End Sub

Function ToArray() As Variant
    ToArray = arraylist.ToArray
End Function

Function ToString() As String
    ToString = arraylist.ToString
End Function

Sub TrinToSize()
    arraylist.TrimToSize
End Sub

Property Get Item(ByVal Index As Long) As Variant
    If IsObject(arraylist.Item(Index)) Then
        Set Item = arraylist.Item(Index)
    Else
        Item = arraylist.Item(Index)
    End If
End Property

Property Let Item(ByVal Index As Long, ByVal value As Variant)
    Let arraylist(Index) = value
End Property

Property Set Item(ByVal Index As Long, ByVal value As Variant)
    Set arraylist(Index) = value
End Property

Property Get capacity() As Long
    capacity = arraylist.capacity
End Property

Property Let capacity(ByVal value As Long)
    arraylist.capacity = value
End Property

Property Get count() As Long
    count = arraylist.count
End Property

'追記

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
        Dim enumerator As IUnknown
        Set enumerator = arraylist.GetEnumerator(0, arraylist.count)
        Set NewEnum = enumerator
End Function

Property Get ItemVal(ByVal Index As Long) As Variant
Attribute Value.VB_UserMemId = 0
    Let ItemVal = arraylist.Item(Index)
End Property

Property Get ItemObj(ByVal Index As Long) As Variant
Attribute Value.VB_UserMemId = 0
    Set ItemObj = arraylist.Item(Index)
End Property

Property Let ItemVal(ByVal Index As Long, ByVal value As Variant)
    Let arraylist(Index) = value
End Property

Property Set ItemObj(ByVal Index As Long, ByVal value As Variant)
    Set arraylist(Index) = value
End Property

修正内容と結果としては
○ForEach出来ない → NewEnumと下記を追加
 → ForEachできました

○Item Getのオブジェクト判定を抜いて →
 ・プロパティの Get ItemVal / Let ItemVal
 ・プロパティの Get ItemObj / Set ItemObj
 を追加し、
 Get側に 'Attribute Value.VB_UserMemId = 0'
 を記載
 → ForEachできました

○Integer型 → Long型
 → 十分なサイズが確保できるようになりました。

○デストラクタが単なるNothing → stackoverflowのDispose方式
 → まぁ実感は特には・・・

ItemプロパティのGet,Set,Letを残しておかないと、For文がエラーに
なっちゃいました。 又、インデクサでの呼び出しも可能になっていました。
これなら、これ一本で十分そうです。