11

List<T>あなたが C# で作成するように VBA で作成したいのですが、それを行う方法はありますか? ここSOでそれについての質問を探しましたが、何も見つかりませんでした。

4

3 に答える 3

22

ジェネリックは C# 2.0 で登場しました。VB6/VBA では、最も近いのはCollection. 、 、 を使用できますがAdd、Remove、、Countなどのより多くの機能が必要な場合は、独自のクラスでラップする必要があります。AddRangeClearContains

Collectionany (つまり、投げたものすべて) を取るので、追加する項目のタイプを確認Variantして、 を強制する必要があります。<T>このTypeName()関数はおそらくこれに役立ちます。

私は挑戦しました:)

更新され た元のコードはこちら

List.cls

VB6/VBA プロジェクトに新しいクラス モジュールを追加します。これにより、実装する機能が定義List<T>されます。[Santosh] の回答が示すように、ラップするコレクション構造の選択には少し制限があります。配列を使用することもできますが、オブジェクトであるコレクションの方が適しています。これは、列挙子に構造体で使用してもらいたいためListですFor Each。

タイプの安全性

とList<T>は、このリストが正確にどのタイプのリストであるかを示しており、制約は、タイプを決定するとT、リストインスタンスがそれに固執することを意味します。VB6では、扱っている型の名前を表す文字列を取得するために使用できるので、私のアプローチはリストに知らせることですTTypeName最初の項目が追加された瞬間に保持している型の名前: C# が VB6 で宣言的に行うことは、ランタイムとして実装できます。しかし、これは VB6 であるため、数値型の型安全性を維持することに夢中になるのはやめましょう。つまり、VB6 よりも賢くすることができます。結局のところ、これは C# コードではありません。言語はそれほど厳密ではないため、リストの最初の項目のサイズよりも小さいサイズの数値型に対してのみ暗黙的な型変換を許可することで妥協することができます。

Private Type tList
    Encapsulated As Collection
    ItemTypeName As String
End Type
Private this As tList
Option Explicit

Private Function IsReferenceType() As Boolean
    If this.Encapsulated.Count = 0 Then IsReferenceType = False: Exit Function
    IsReferenceType = IsObject(this.Encapsulated(1))
End Function

Public Property Get NewEnum() As IUnknown
    Attribute NewEnum.VB_Description = "Gets the enumerator from encapsulated collection."
    Attribute NewEnum.VB_UserMemId = -4
    Attribute NewEnum.VB_MemberFlags = "40"

    Set NewEnum = this.Encapsulated.[_NewEnum]
End Property

Private Sub Class_Initialize()
    Set this.Encapsulated = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Encapsulated = Nothing
End Sub

public値が適切な型であるかどうかを検証することは、便宜上作成できる関数の役割になる可能性があるため、値が実際に追加される前に、クライアント コードによって有効であることをテストできます。New Listを初期化するたびにthis.ItemTypeName、そのインスタンスの空の文字列です。残りの時間はおそらく正しい型が表示されるので、すべての可能性をわざわざチェックしないようにしましょう (C# ではなくOr、ステートメントに続く最初の部分で評価が中断されることはありませんtrue)。

Public Function IsTypeSafe(value As Variant) As Boolean

    Dim result As Boolean
    result = this.ItemTypeName = vbNullString Or this.ItemTypeName = TypeName(value)
    If result Then GoTo QuickExit

    result = result _
        Or this.ItemTypeName = "Integer" And StringMatchesAny(TypeName(value), "Byte") _
        Or this.ItemTypeName = "Long" And StringMatchesAny(TypeName(value), "Integer", "Byte") _
        Or this.ItemTypeName = "Single" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte") _
        Or this.ItemTypeName = "Double" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single") _
        Or this.ItemTypeName = "Currency" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single", "Double")

QuickExit:
    IsTypeSafe = result
End Function

それではスタートです。

したがって、 がありCollectionます。Count、Add、Remove、および を購入しItemます。後者はCollectionのデフォルト プロパティでもあり、C# ではインデクサープロパティと呼ばれるため、興味深いものです。VB6 では、Item.VB_UserMemId属性を 0 に設定し、デフォルト プロパティを取得します。

Public Property Get Item(ByVal index As Long) As Variant
    Attribute Item.VB_Description = "Gets/sets the item at the specified index."
    Attribute Item.VB_UserMemId = 0

    If IsReferenceType Then
        Set Item = this.Encapsulated(index)
    Else
        Item = this.Encapsulated(index)
    End If
End Property

プロシージャの属性

VBA では、IDE はそれらを編集する方法を提供しませんが、メモ帳でコードを編集し、編集した .cls ファイルを VBA プロジェクトにインポートできます。VB6 では、これらを編集するための [ツール] メニューがあります。

プロシージャ属性 プロシージャ属性

Attribute NewEnum.VB_UserMemId = -4このプロパティを使用して列挙子を提供するように VB に指示します - カプセル化された のプロパティを渡すだけCollectionで、アンダースコアで始まる非表示のプロパティです (自宅でこれを試さないでください!)。Attribute NewEnum.VB_MemberFlags = "40"隠しプロパティにすることも想定されていますが、VB がそれを認識しない理由はまだわかりません。そのため、隠しプロパティのゲッターを呼び出すには、角かっこで囲む必要があり[]ます。これは、VB6/VBA では識別子をアンダースコアで始めることは合法的にできないためです。

このNewEnum.VB_Description属性の良いところは、そこに入力した説明がコードの説明/ミニ ドキュメントとしてオブジェクト ブラウザ( ) に表示されることです。F2

アイテムアクセサー/「セッター」

VB6/VBACollectionでは、項目に値を直接書き込むことはできません。参照を割り当てることはできますが、値を割り当てることはできません。Listプロパティにセッターを提供することで、書き込み可能を実装できます。値または参照/オブジェクトになるItemかどうかがわからないため、アクセサーとアクセサーの両方を提供します。はこれをサポートしていないため、最初に指定されたインデックスの項目を削除してから、その場所に新しい値を挿入する必要があります。TLetSetCollection

朗報です。RemoveAtとはInsertとにかく実装する必要がある 2 つのメソッドであり、RemoveAtそのセマンティクスはカプセル化された のセマンティクスと同じであるため、無料で提供されますCollection。

Public Sub RemoveAt(ByVal index As Long)
    this.Encapsulated.Remove index
End Sub

Public Sub RemoveRange(ByVal Index As Long, ByVal valuesCount As Long)
    Dim i As Long
    For i = Index To Index + valuesCount - 1
        RemoveAt Index
    Next
End Sub

の私の実装はInsertもっと良くなる可能性があるように感じますが、基本的には「指定されたインデックスの後のすべてを取得し、コピーを作成します。指定されたインデックスの後のすべてを削除し、指定された値を追加し、残りのアイテムを追加し直します」:

Public Sub Insert(ByVal index As Long, ByVal value As Variant)
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If index > Count Then Err.Raise 9  'index out of range

    For i = index To Count
        tmp.Add Item(i)
    Next

    For i = index To Count
        RemoveAt index
    Next

    Add value
    Append tmp

End Sub

InsertRangeを取ることができるParamArrayので、インライン値を提供できます。

Public Sub InsertRange(ByVal Index As Long, ParamArray values())
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If Index > Count Then Err.Raise 9  'index out of range

    For i = Index To Count
        tmp.Add Item(i)
    Next

    For i = Index To Count
        RemoveAt Index
    Next

    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
    Append tmp

End Sub

Reverseソートとは関係がないため、すぐに実装できます。

Public Sub Reverse()
    Dim i As Long, tmp As New List

    Do Until Count = 0
        tmp.Add Item(Count)
        RemoveAt Count
    Loop

    Append tmp

End Sub

VB6はオーバーロードをサポートしていないので、ここで私は考えました。別のリストからすべてのアイテムを追加できるメソッドがあればいいので、それを呼び出しましたAppend：

Public Sub Append(ByRef values As List)
    Dim value As Variant, i As Long
    For i = 1 To values.Count
        Add values(i)
    Next
End Sub

AddListいくつかの追加のメソッドでカプセル化されているだけでCollectionはありません。リストに追加される最初のアイテムである場合、ここで実行するロジックがあります-アイテムがいくつあるか気にしないというわけではありませんカプセル化されたコレクションであるため、すべての項目がリストから削除された場合、型はT制約されたままになります。

Public Sub Add(ByVal value As Variant)
    If this.ItemTypeName = vbNullString Then this.ItemTypeName = TypeName(value)
    If Not IsTypeSafe(value) Then Err.Raise 13, ToString, "Type Mismatch. Expected: '" & this.ItemTypeName & "'; '" & TypeName(value) & "' was supplied." 'Type Mismatch
    this.Encapsulated.Add value
End Sub

失敗したときに発生するエラーの原因は、を返すメソッドAddの呼び出しの結果です... T の型を含む型の名前 - したがって、 a の代わりに a にすることができます。ToStringList<T>List(Of T)

Public Function ToString() As String
    ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">"
End Function

List<T>一度に多くのアイテムを追加できます。最初AddRangeは、パラメーターの値の配列を使用して実装しましたが、使用すると、これは C# ではなく、a を取り込むParamArray方がはるかに便利であることに気付きました。

Public Sub AddRange(ParamArray values())
    Dim value As Variant, i As Long
    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
End Sub

...そして、これらのItemセッターに到達します。

Public Property Let Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

Public Property Set Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

インデックスの代わりに値を提供してアイテムを削除するには、その値のインデックスを提供する別のメソッドが必要になります。また、値型だけでなく参照型もサポートしているため、これは非常に楽しいものになるでしょう。参照型間の等価性を判断する方法が必要です- を比較することで参照の等価性を得ることができますObjPtr(value)が、それ以上のものが必要になります - .net フレームワークは と について教えてくれましIComparableたIEquatable。IComparableこれら 2 つのインターフェイスを 1つに詰め込んで呼び出しましょう。はい、VB6/VBA でインターフェイスを作成して実装できます。

IComparable.cls

新しいクラス モジュールを追加してそれを呼び出しIComparableます。実際にそれらを別の目的で使用する予定がある場合は、それらを 2 つの別個のクラス モジュールに配置して、もう 1 つを呼び出すことIEquatableができますが、1 つではなく 2 つのインターフェイスを実装することになります。操作できるようにしたい参照型。

これはモックアップ コードではありません。必要なのはメソッド シグネチャだけです。

Option Explicit

Public Function CompareTo(other As Variant) As Integer
'Compares this instance with another; returns one of the following values:
'   -1 if [other] is smaller than this instance.
'    1 if [other] is greater than this instance.
'    0 otherwise.
End Function

Public Function Equals(other As Variant) As Boolean
'Compares this instance with another; returns true if the two instances are equal.
End Function

List.cls

IComparable インターフェイスを使用する

とをパックしたIComparableので、リスト内の任意の値のインデックスを見つけることができます。リストに指定された値が含まれているかどうかを判断することもできます。CompareToEquals

Public Function IndexOf(value As Variant) As Long
    Dim i As Long, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For i = 1 To this.Encapsulated.Count
        If isRef Then
            If TypeOf this.Encapsulated(i) Is IComparable And TypeOf value Is IComparable Then
                Set comparable = this.Encapsulated(i)
                If comparable.Equals(value) Then
                    IndexOf = i
                    Exit Function
                End If
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(this.Encapsulated(i)) = ObjPtr(value) Then
                    IndexOf = i
                    Exit Function
                End If
            End If
        Else
            If this.Encapsulated(i) = value Then
                IndexOf = i
                Exit Function
            End If
        End If
    Next
    IndexOf = -1
End Function

Public Function Contains(value As Variant) As Boolean
    Dim v As Variant, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For Each v In this.Encapsulated
        If isRef Then
            If TypeOf v Is IComparable And TypeOf value Is IComparable Then
                Set comparable = v
                If comparable.Equals(value) Then Contains = True: Exit Function
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(v) = ObjPtr(value) Then Contains = True: Exit Function
            End If
        Else
            If v = value Then Contains = True: Exit Function
        End If
    Next
End Function

このメソッドは、 andの値がCompareTo何であるかを尋ね始めたときに機能します。MinMax

Public Function Min() As Variant
    Dim i As Long, isRef As Boolean
    Dim smallest As Variant, isSmaller As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(smallest) Then
            Set smallest = Item(i)
        ElseIf IsEmpty(smallest) Then
            smallest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isSmaller = comparable.CompareTo(smallest) < 0
        Else
            isSmaller = Item(i) < smallest
        End If

        If isSmaller Then
            If isRef Then
                Set smallest = Item(i)
            Else
                smallest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Min = smallest
    Else
        Min = smallest
    End If

End Function

Public Function Max() As Variant
    Dim i As Long, isRef As Boolean
    Dim largest As Variant, isLarger As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(largest) Then
            Set largest = Item(i)
        ElseIf IsEmpty(largest) Then
            largest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isLarger = comparable.CompareTo(largest) > 0
        Else
            isLarger = Item(i) > largest
        End If

        If isLarger Then
            If isRef Then
                Set largest = Item(i)
            Else
                largest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Max = largest
    Else
        Max = largest
    End If

End Function

これらの 2 つの関数を使用すると、非常に読みやすい並べ替えが可能になります。ここで行われていること (項目の追加と削除) のため、すぐに失敗する必要があります。

Public Sub Sort()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: Sort() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, minValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set minValue = Min
        Else
            minValue = Min
        End If

        tmp.Add minValue
        RemoveAt IndexOf(minValue)
    Loop

    Append tmp

End Sub

Public Sub SortDescending()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: SortDescending() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, maxValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set maxValue = Max
        Else
            maxValue = Max
        End If

        tmp.Add maxValue
        RemoveAt IndexOf(maxValue)
    Loop

    Append tmp

End Sub

最後の仕上げ

残りは些細なことです：

Public Sub Remove(value As Variant)
    Dim index As Long
    index = IndexOf(value)
    If index <> -1 Then this.Encapsulated.Remove index
End Sub

Public Property Get Count() As Long
    Count = this.Encapsulated.Count
End Property

Public Sub Clear()
    Do Until Count = 0
        this.Encapsulated.Remove 1
    Loop
End Sub

Public Function First() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(1)) Then
        Set First = Item(1)
    Else
        First = Item(1)
    End If
End Function

Public Function Last() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(Count)) Then
        Set Last = Item(Count)
    Else
        Last = Item(Count)
    End If
End Function

興味深い点の 1 つList<T>は、それを呼び出すだけで配列にコピーToArray()できることです。まさにそれを行うことができます。

Public Function ToArray() As Variant()

    Dim result() As Variant
    ReDim result(1 To Count)

    Dim i As Long
    If Count = 0 Then Exit Function

    If IsReferenceType Then
        For i = 1 To Count
            Set result(i) = this.Encapsulated(i)
        Next
    Else
        For i = 1 To Count
            result(i) = this.Encapsulated(i)
        Next
    End If

    ToArray = result
End Function

それで全部です！

私はいくつかのヘルパー関数を使用しています。ここにそれらがあります-おそらくいくつかのStringHelpersコードモジュールに属しています:

Public Function StringMatchesAny(ByVal string_source As String, find_strings() As Variant) As Boolean

    Dim find As String, i As Integer, found As Boolean

    For i = LBound(find_strings) To UBound(find_strings)

        find = CStr(find_strings(i))
        found = (string_source = find)

        If found Then Exit For
    Next

    StringMatchesAny = found

End Function

Public Function Coalesce(ByVal value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant

    Dim return_value As Variant
    On Error Resume Next 'supress error handling

    If IsNull(value) Or (TypeName(value) = "String" And value = vbNullString) Then
        return_value = value_when_null
    Else
        return_value = value
    End If

    Err.Clear 'clear any errors that might have occurred
    On Error GoTo 0 'reinstate error handling

    Coalesce = return_value

End Function

MyClass.cls

この実装では、が参照型/オブジェクトの場合、並べ替え可能にするため、および値のインデックスを見つけるためにT、クラスがインターフェイスを実装する必要があります。IComparableこれがどのように行われるかです - と呼ばれるMyClass数値またはStringプロパティで呼び出されるクラスがあるとしますSomeProperty:

Implements IComparable
Option Explicit

Private Function IComparable_CompareTo(other As Variant) As Integer
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    If comparable Is Nothing Then IComparable_CompareTo = 1: Exit Function

    If Me.SomeProperty < comparable.SomeProperty Then
        IComparable_CompareTo = -1
    ElseIf Me.SomeProperty > comparable.SomeProperty Then
        IComparable_CompareTo = 1
    End If

End Function

Private Function IComparable_Equals(other As Variant) As Boolean
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    IComparable_Equals = comparable.SomeProperty = Me.SomeProperty

End Function

は次のListように使用できます。

Dim myList As New List
myList.AddRange 1, 12, 123, 1234, 12345 ', 123456 would blow up because it's a Long
myList.SortDescending

Dim value As Variant
For Each value In myList
   Debug.Print Value
Next

Debug.Print myList.IndexOf(123) 'prints 3
Debug.Print myList.ToString & ".IsTypeSafe(""abc""): " & myList.IsTypeSafe("abc")
    ' prints List<Integer>.IsTypeSafe("abc"): false
于 2013-10-03T00:10:14.323 に答える
4

これが古い投稿であることは承知していますが、議論されたことに加えて、次のことを言及したいと思います...

配列リスト

ArrayListを使用できます。これは、VBA で使用できる弱い型付け (強い型付けではなくオブジェクトを使用) のリンク リストです。基本的な使用方法を示すサンプル コードを次に示します。

Sub ArrayListDemo()
    Dim MyArray(1 To 7) As String
    MyArray(1) = "A"
    MyArray(2) = "B"
    MyArray(3) = "B"
    MyArray(4) = "i"
    MyArray(5) = "x"
    MyArray(6) = "B"
    MyArray(7) = "C"
    Set L1 = ToList(MyArray)
    L1.Insert L1.LastIndexOf("B"), "Zz"
    Set L2 = L1.Clone
    L2.Sort
    L2.Reverse
    L2.Insert 0, "----------------"
    L2.Insert 0, "Sort and Reverse"
    L2.Insert 0, "----------------"
    L1.AddRange L2.Clone
    Set L3 = SnipArray(L1, 9, 3)
    Debug.Print "---- L1 Values ----"
    For Each obj In L1
        Debug.Print obj & " (L1 & L3 = " & L3.Contains(obj) & ")"
    Next
    Debug.Print "---- L3 Values ----"
    For Each obj In L3
        Debug.Print obj
    Next
End Sub
Function ToList(ByVal Arr As Variant) As Object
    Set ToList = CreateObject("System.Collections.ArrayList")
    For Each Elm In Arr
      ToList.Add Elm
    Next Elm
End Function
Function SnipArray(ByVal ArrayList As Object, lower As Integer, length As Integer) As Object
    Set SnipArray = ArrayList.Clone
    lower = lower - 1
    upper = lower + length
    If upper < ArrayList.Count Then
        SnipArray.RemoveRange upper, (ArrayList.Count - upper)
    End If
    If lower > 0 Then
        SnipArray.RemoveRange 0, lower
    End If
End Function

辞書

また、辞書を見てうれしいとのことでした。VBA で辞書を使用し、それをリストのように使用する方法に関するいくつかの注意事項を次に示します。

Sub DictionaryDemo()
    'If you have a reference to "Microsoft Scripting Runtime..."'
    Set D = New Dictionary
    'Else use this if you do not want to bother with adding a reference'
    Set D = CreateObject("Scripting.Dictionary")

    'You can structure a dictionary as a zero based array like this'
    D.Add D.Count, "A"
    Debug.Print D(0)

    Set D = Nothing
End Sub
于 2015-09-01T19:43:40.047 に答える