仕事柄未だにVB6を保守することがあるのだが、For eachが使える可変長配列が欲しかったのでVBScript用に作っていたArraylistを移植してみた。「class ArrayList~end class」で囲めばVBScriptでそのまま動く。
ファイル名 Arraylist.cls
Option Explicit Private m_Item() Private m_count '末尾にItemを追加 Public Sub Add(x) ReDim Preserve m_Item(m_count) If IsObject(x) Then Set m_Item(m_count) = x Else m_Item(m_count) = x End If m_count = m_count + 1 End Sub 'I番目の内容をxで書き換え Public Sub Change(I, x) If IsObject(x) Then Set m_Item(I) = x Else m_Item(I) = x End If End Sub '総数を返す Public Function count() count = m_count End Function '全消去 Public Function Clear() m_count = 0 Erase m_Item End Function 'For each 用 例 yがArrayListなら For each x in y.item Public Function Item() Item = m_Item End Function 'n番目のItemを返す Public Function Items(n) If IsObject(m_Item(n)) Then Set Items = m_Item(n) Else Items = m_Item(n) End If End Function 'n番目のItemを削除 Public Sub RemoveAt(n) If m_count >= n Then Dim I For I = n To m_count - 1 - 1 Call Change(I, Items(I + 1)) Next I m_count = m_count - 1 ReDim Preserve m_Item(m_count) Else MsgBox ("引数が範囲外") End If End Sub '引数と同じItemを全て削除 Public Sub Remove(itm) Dim I For I = m_count - 1 To 0 Step -1 If Items(I) = itm Then RemoveAt (I) End If Next I End Sub 'ソート Public Function Sort() If m_count = 0 Then Exit Function End If Dim I, J, swap For I = 0 To m_count - 1 For J = I To m_count - 1 - 1 If m_Item(J) > m_Item(J + 1) Then swap = m_Item(J) m_Item(J) = m_Item(J + 1) m_Item(J + 1) = swap End If Next J Next I End Function
使用例
Private Sub Command1_Click() Dim m As New Arraylist m.Add (34) m.Add (3) m.Add (11) m.Add (28) m.Add (17) m.Add (11) For Each s In m.Item Text1.Text = Text1.Text + " " + str$(s) Next m.Remove (11) MsgBox (m.count) For Each s In m.Item Text1.Text = Text1.Text + " " + str$(s) Next For Each s In m.Item Text1.Text = Text1.Text + " " + str$(s) Next m.Sort For Each s In m.Item Text1.Text = Text1.Text + " " + str$(s) Next End Sub