以字段名作为参数的 VBA 数组排序

Question

这就是交易...为了克服我对 Excel VBA 中的类模块的恐惧，我决定创建一个数组类，然后添加用于添加元素、对实例进行排序等的函数（方法）。这些是我在普通模块中作为函数/子程序不断重写的东西，但希望使用类可能是向前迈出的一步。

代码模块

Public Type Thing
   Name As String
   SomeNumber As Double
End Type

类模块

Private pSomething() As Thing

后面是所有常用的公共 LET 和 GET，以及一个用于将新值插入数组的函数。然后我进入排序功能/方法。按 Name 或 SomeNumber 排序没有问题，但到目前为止需要两个函数/方法。我想参数化为单个函数/方法，然后使用可选参数来控制要使用的字段。以下工作，但它似乎有点笨拙

Function SortByField(Optional FieldName As String, Optional SortOrder As vbaSortOrder)
    Dim strTemp As Thing
    If SortOrder = 0 Then SortOrder = soBottomToTop
    If Len(FieldName) = 0 Then FieldName = "Name"
    Dim i As Long
    Dim j As Long
    Dim lngMin As Long
    Dim lngMax As Long
    lngMin = LBound(pSomething)
    lngMax = UBound(pSomething)
    For i = lngMin To lngMax - 1
      For j = i + 1 To lngMax
        If IIf(SortOrder = soBottomToTop, _
                              IIf(FieldName = "Name", pSomething(i).Name > pSomething(j).Name, _
                                                       pSomething(i).SomeNumber > pSomething(j).SomeNumber), _
                              IIf(FieldName = "Name", pSomething(i).Name < pSomething(j).Name, _
                                                       pSomething(i).SomeNumber < pSomething(j).SomeNumber)) _
                              Then
          strTemp = pSomething(i)
          pSomething(i) = pSomething(j)
          pSomething(j) = strTemp
        End If
      Next j
    Next i
End Function

我想做的是替换以下内容（它在这个愚蠢的 IF(IIF...) 废话的第二部分中是对等的

IIf(FieldName = "Name", pSomething(i).Name > pSomething(j).Name, pSomething(i).SomeNumber > pSomething(j).SomeNumber)

...像这样的东西

"pSomething(i)." & FieldName > "pSomething(j)." & FieldName

直接问题：如何让字符串评估/转换为代码？

间接问题：是否有其他技术可以传入字段名并将其视为字符串以外的其他内容？

在此先感谢您提供的任何帮助、帮助、指导、指导、参考、建议，这是愚蠢的差事或嘲讽的 cmets :)。

Answer 1

比格顿， 我试图遵循你的代码，你是对的，嵌套的 IIF 是愚蠢的。我可以建议您使用 SELECT CASE 语句重写代码吗？这可能有点帮助。 此外，您要实现的大目标是什么？这对于一维数组来说几乎是多余的。

您可能还可以利用其他内置的 Excel VBA 方法。

我刚刚在网上快速搜索了有关排序数组的信息，然后发现了 Pearson 的网站http://www.cpearson.com/excel/SortingArrays.aspx

你可能要检查一下。

Answer 2

@BiggerDon， 对于每个字段都有一个属性的自定义类型类怎么样。 循环遍历记录并将它们添加到自定义类的集合中。当您这样做时，您将确定哪个字段将用作集合的键。 然后使用类似这里介绍的东西。 How do I sort a collection?

Answer 3

考虑一种基于自定义类而不是类型的方法，并使用 VBScript 中的Eval() 方法来评估项目的字段值。

将下面的代码放在VBA模块中：

Sub TestStorage()
    Dim Room As New Storage
    Dim i As Long
    Dim Elem As Object
    Dim Item As Variant
    Dim Result As String

    For i = 1 To 10
        Set Elem = New OrdinalType
        Elem.Name = GetRandomFruit
        Elem.Index = i
        Room.Push Elem
    Next
    For i = 11 To 20
        Set Elem = New ExtendedType
        Elem.Name = GetRandomFruit
        Elem.Index = i
        Elem.Additional = "Extended"
        Room.Push Elem
    Next
    Set Elem = Nothing

    ShowList Room.GetContent

    Room.SortByField "Name", True
    ShowList Room.GetContent

    Room.SortByField "Index", False
    ShowList Room.GetContent

End Sub

Sub ShowList(Arr)
    Result = ""
    For Each Item In Arr
        Result = Result & Item.Name & " (" & Item.Index & ")"
        If TypeName(Item) = "ExtendedType" Then
            Result = Result & " " & Item.Additional
        End If
        Result = Result & vbCrLf
    Next
    MsgBox Result
End Sub

Function GetRandomFruit()
    Dim Fruits
    Randomize
    Fruits = Array("Apple", "Apricot", "Banana", "Bilberry", "Blackberry", "Blackcurrant", "Blueberry", "Coconut", "Currant", "Cherry", "Cherimoya", "Clementine", "Date", "Damson", "Durian", "Elderberry", "Fig", "Feijoa", "Gooseberry", "Grape", "Grapefruit", "Huckleberry", "Jackfruit", "Jambul", "Jujube", "Kiwifruit", "Kumquat", "Lemon", "Lime", "Loquat", "Lychee", "Mango", "Mangostine", "Melon", "Cantaloupe", "Honeydew", "Watermelon", "Rock melon", "Nectarine", "Orange", "Passionfruit", "Peach", "Pear", "Plum", "Prune", "Pineapple", "Pomegranate", "Pomelo", "Raisin", "Raspberry", "Rambutan", "Redcurrant", "Satsuma", "Strawberry", "Tangerine", "Ugli Fruit")
    GetRandomFruit = Fruits(LBound(Fruits) + Round(Rnd * (UBound(Fruits) - LBound(Fruits))))
End Function

添加对 Microsoft 脚本控件 ActiveX（菜单 - 工具 - 参考）的引用。
将下面的代码放入 VBA 类模块，名称为 Storage：

Private Content As Variant
Private SC As MSScriptControl.ScriptControl

Private Sub Class_Initialize()
    Set SC = New MSScriptControl.ScriptControl
    SC.Language = "VBScript"
    SC.ExecuteStatement "Function EvalProp(Item, Name): EvalProp = Eval(""Item."" & Name): End Function"
    Content = Array()
End Sub

Private Function GetValue(ObjectInstance, PropertyName)
    GetValue = SC.Run("EvalProp", ObjectInstance, PropertyName)
End Function

Public Sub Push(Item)
    ReDim Preserve Content(UBound(Content) + 1)
    Set Content(UBound(Content)) = Item
End Sub

Public Function Pop()
    Set Pop = Content(UBound(Content))
    ReDim Preserve Content(UBound(Content) - 1)
End Function

Public Sub SortByField(Optional PropName As String = "Name", Optional SortAsc As Boolean = True)
    Dim i As Long
    Dim j As Long
    Dim l As Long
    Dim u As Long
    Dim a As Variant
    Dim b As Variant
    Dim tmp As Object
    l = LBound(Content)
    u = UBound(Content)
    For i = l To u - 1
        For j = i + 1 To u
            a = GetValue(Content(i), PropName)
            b = GetValue(Content(j), PropName)
            If (a > b And SortAsc) Or (a < b And Not SortAsc) Then
                Set tmp = Content(j)
                Set Content(j) = Content(i)
                Set Content(i) = tmp
            End If
        Next j
    Next i
End Sub

Public Function GetContent()
    GetContent = Content
End Function

Public Function GetSize()
    GetSize = UBound(Content) - LBound(Content) + 1
End Function

将下面的代码放入VBA类模块，名称OrdinalType：

Public Name As String
Public Index As Double

将下面的代码放入VBA类模块，名称ExtendedType：

Public Name As String
Public Index As Double
Public Additional As String

这个例子展示了如何在能够处理这些类型的存储对象中创建和存储不同类型的实例，在这种特殊情况下 - 以字符串作为排序字段名称对它们进行排序。请注意，这种 VBS 注入是异常的，通常不是最佳实践。关于处理速度 - 在我的 N7110 上，Function GetValue() 调用大约需要 15 毫秒。