こちらの続きです。
ArrayListラッパークラスをお借りしてみる - C#ATIA
イロイロとコメントで教えて頂いたので、こちらの.NETFramework_ArrayListの
ラッパークラスに
AarrayListをvbaで使いやすいようにラップしてみた : 趣味のプログラムあれこれ
こちらを反映してみました。
Wrap .Net ArrayList with custom VBA class get iterator - Stack Overflow
ArrayListラッパークラスです。こちらは直接ペーストするとエラーになってしまいます。
一度エクスポートして・・・thomさんのこちらのサイトがわかりやすいかと思います。
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文がエラーに
なっちゃいました。 又、インデクサでの呼び出しも可能になっていました。
これなら、これ一本で十分そうです。