其他可能性

Question

我是否可以通过有效的排序和过滤对象来访问任何数据结构？

对于排序，System.Collections.ArrayList是完美的，因为我只需添加一大堆Implement IComparable和.Sort()的类。但是我找不到.Filter()方法，因为可能存在一些articles提示（第9.3节）。

是否有一个好的集合类型来过滤和排序自定义对象？最好是用预编译语言编写的东西。

一个简单的对象如下所示：

Implements IComparable                           'requires mscorlib.dll, allows sorting

Public itemIndex As Long                        'simplest, sorting by an integer value

Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    'for sorting, itemindex is based on current grid sorting mode
    If TypeOf obj Is clsGridItem Then
        Dim other As clsGridItem: Set other = obj
        Dim otherIndex As Long: otherIndex = other.itemIndex
        Dim thisIndex As Long: thisIndex = Me.itemIndex
        If thisIndex > otherIndex Then
            IComparable_CompareTo = 1
        ElseIf thisIndex < otherIndex Then
            IComparable_CompareTo = -1
        Else
            IComparable_CompareTo = 0
        End If
    Else
        Err.Raise 5                              'obj is wrong type
    End If

End Function

我有一个用随机索引填充的arrayList。当然，任何事情都可以进入比较例程（我实际上根据类的不同属性使用Select Case用于不同的比较例程）。一个简单的过滤器循环可以检查何时IComparable_CompareTo = 0

Answer 1

排序功能是内置于ArrayList对象的，过滤仅仅是＆＃34;只使用你需要的项目＆＃34;。

例如，这会使用随机数填充对象，然后过滤结果以仅显示可被42整除的对象：

Option Explicit

Sub testSort()

    Const filter = 42
    Dim arr As Object, x As Long, y As Long
    Set arr = CreateObject("System.Collections.ArrayList")

    ' populate array with 100 random numbers
    For x = 1 To 420
        arr.Add Int(Rnd() * 10000)
    Next

    ' "sort" array
    arr.Sort

    ' dump array to immediate window; "filter" to show only even numbers
    For x = 0 To arr.Count - 1
        If arr(x) / filter = arr(x) \ filter Then
            'item mnatches filter
            Debug.Print "arr(" & x & ") = " & arr(x)
            y = y + 1
        End If
    Next x

    Debug.Print "Returned " & y & " sorted results (Filter=" & filter & ")"
End Sub

其他可能性

您还没有分享有关过滤所需的以及的详细信息，但我进一步考虑了这一点，您可能想要检查这些看看它们是否适用于你的任务：

MSDN： Filter Function（VBA）
^{返回基于零的数组，该数组包含基于指定过滤条件的字符串数组的子集}
excelfunctions.net： FILTER Function（VBA）
MSDN： Filtering Items in a Collection（VBA）
msdocs： CreateObject("System.Collections.ArrayList")（VB）
^{根据指定的类型}
msdocs： ArrayList Class Constructors（VB）
Stack Overflow： How to implement class constructor in Visual Basic?（VB）
Stack Overflow： VBA array sort function（VB / VBA）
维基百科： Comparison of popular sorting algorithms

Answer 2

对任何可枚举的内容进行任意过滤是Enumerable.Where所做的事情，它是在委托的帮助下完成的，这是VBA不了解或无法实现的。

警告以下是不适合生产使用的实验代码。它按原样提供用于教育目的。使用风险自负。

你可以模拟。请参阅代码审核中的Wait, is this... LINQ?和Generating and calling code on the fly - 以下是我称为Delegate的课程 - 请注意，其PredeclaredId属性设置为True，因此可以从默认实例调用其Create工厂方法。它使用正则表达式库来解析函数的定义，并使用VBE可扩展性API库来字面地生成给定字符串的“匿名函数”，例如：

Set x = Delegate.Create("(x) => MsgBox(""Hello, "" & x & ""!"")")
x.Execute "Mug"

以上代码生成并调用此函数：

Public Function AnonymousFunction(ByVal x As Variant) As Variant
AnonymousFunction = MsgBox("Hello, " & x & "!")
End Function

产生你期望的东西：

Hello, Mug!

委派类

Option Explicit

Private Type TDelegate
    Body As String
    Parameters As New Collection
End Type

Private Const methodName As String = "AnonymousFunction"
Private this As TDelegate

Friend Property Get Body() As String
    Body = this.Body
End Property

Friend Property Let Body(ByVal value As String)
    this.Body = value
End Property

Public Function Create(ByVal expression As String) As Delegate

    Dim result As New Delegate

    Dim regex As New RegExp
    regex.Pattern = "\((.*)\)\s\=\>\s(.*)"

    Dim regexMatches As MatchCollection
    Set regexMatches = regex.Execute(expression)

    If regexMatches.Count = 0 Then
        Err.Raise 5, "Delegate", "Invalid anonymous function expression."
    End If

    Dim regexMatch As Match
    For Each regexMatch In regexMatches
        If regexMatch.SubMatches(0) = vbNullString Then

            result.Body = methodName & " = " & Right(expression, Len(expression) - 6)

        Else
            Dim params() As String
            params = Split(regexMatch.SubMatches(0), ",")

            Dim i As Integer
            For i = LBound(params) To UBound(params)
                result.AddParameter Trim(params(i))
            Next

            result.Body = methodName & " = " & regexMatch.SubMatches(1)

        End If

    Next

    Set Create = result

End Function

Public Function Execute(ParamArray params()) As Variant

    On Error GoTo CleanFail

    Dim paramCount As Integer
    paramCount = UBound(params) + 1

    GenerateAnonymousMethod
    'cannot break beyond this point

    Select Case paramCount

        Case 0
            Execute = Application.Run(methodName)
        Case 1
            Execute = Application.Run(methodName, params(0))
        Case 2
            Execute = Application.Run(methodName, params(0), params(1))
        Case 3
            Execute = Application.Run(methodName, params(0), params(1), params(2))
        Case 4
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3))
        Case 5
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4))
        Case 6
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5))
        Case 7
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6))
        Case 8
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7))
        Case 9
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8))
        Case 10
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8), _
                                                  params(9))

        Case Else
            Err.Raise 5, "Execute", "Too many parameters."

    End Select

CleanExit:
    DestroyAnonymousMethod
    Exit Function

CleanFail:
    Resume CleanExit
End Function

Friend Sub AddParameter(ByVal paramName As String)
    this.Parameters.Add "ByVal " & paramName & " As Variant"
End Sub

Private Sub GenerateAnonymousMethod()

    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")

    Dim params As String
    If this.Parameters.Count > 0 Then
        params = Join(Enumerable.FromCollection(this.Parameters).ToArray, ", ")
    End If

    Dim signature As String
    signature = "Public Function " & methodName & "(" & params & ") As Variant" & vbNewLine

    Dim content As String
    content = vbNewLine & signature & this.Body & vbNewLine & "End Function" & vbNewLine

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines
    component.CodeModule.AddFromString content

End Sub

Private Sub DestroyAnonymousMethod()

    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines

End Sub

您需要将VBProjects("Reflection").VBComponents("AnonymousCode")更改为指向VBA项目中的某个空标准模块...或者将项目命名为Reflection，其中包含名为AnonymousCode的空标准模块用Execute方法生成函数。

作为如何编译VBA代码的工件，可以执行生成的代码，但是你不能在其中放置断点，VBE将拒绝在生成的代码中打破 - 所以你提供给工厂的任何字符串方法，你最好确保它足够简单，100％无错误。

这给你的是一个封装特定动作的对象：这个对象可以作为参数传递，就像任何其他对象一样 - 所以如果你有自己的集合类实现（这里LinqEnumerable），然后您可以使用它来实现一个带有Where参数的Delegate方法，假设predicate参数封装了一个返回Boolean的函数}：

Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
    Dim result As LinqEnumerable    
    Set result = New LinqEnumerable
    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then result.Add element
    Next
    Set Where = result
End Function

因此，给定自定义集合类，您可以创建一个定义自定义条件的Delegate实例，将其传递给Where方法，然后返回过滤后的结果。

您甚至可以进一步推动它并实施Aggregate方法：

Public Function Aggregate(ByVal accumulator As Delegate) As Variant
    Dim result As Variant    
    Dim isFirst As Boolean    
    Dim value As Variant
    For Each value In encapsulated
        If isFirst Then
            result = value
            isFirst = False
        Else
            result = accumulator.Execute(result, value)
        End If
    Next    
    Aggregate = result    
End Function

运行它就像使用C＃LINQ一样，减去编译时类型的安全性和延迟执行：

Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")

Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
                          .Aggregate(accumulator)

输出：

fox brown quick the

这项工作是GitHub上VBEX存储库中Lambda内容的基础（最初由Rubberduck项目的联合创始人Chris McClellan提供;大部分工作都归功于Philip Wales虽然） - 一个100％-VBA项目，为您提供其他几个类。我鼓励您探索这些，看看它们是否更适合生产使用。

Answer 3

感谢您提出此问题。我一直在计划在VBA中使用C＃中的功能的博客条目，这个问题促使我。我在这个主题上写了comprehensive blog entry。（我甚至做过Youtube video discussing the solution's source code）。

我提供的解决方案是使用C＃编写一个执行COM互操作的类库DLL。它是一个通用列表的子类，它还有一个lambda表达式解析器，因此VBA代码可以将lambda传递给Where方法并获得一个过滤列表。

您没有在课程中提供课程供我们进行实验。所以，我将在这里给出一个名为CartesianPoint的类，它带有一个Angle方法和一个Magnitude方法，我们可以使用过滤器。该类还实现了IComparable，因此它可以参与排序。该类实现了一个足以运行lambda表达式的接口。

Option Explicit

'written by S Meaden

Implements mscorlib.IComparable '* Tools->References->mscorlib
Implements LinqInVBA.ICartesianPoint


Dim PI

Public x As Double
Public y As Double

Public Function Magnitude() As Double
    Magnitude = Sqr(x * x + y * y)
End Function

Public Function Angle() As Double
    Angle = WorksheetFunction.Atan2(x, y)
End Function

Public Function AngleInDegrees() As Double
    AngleInDegrees = Me.Angle * (360 / (2 * PI))
End Function

Private Sub Class_Initialize()
    PI = 4 * Atn(1)
End Sub

Private Function ICartesianPoint_AngleInDegrees() As Double
    ICartesianPoint_AngleInDegrees = Me.AngleInDegrees
End Function

Private Function ICartesianPoint_Magnitude() As Double
    ICartesianPoint_Magnitude = Me.Magnitude
End Function

Private Property Get ICartesianPoint_ToString() As String
    ICartesianPoint_ToString = ToString
End Property

Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    Dim oPoint2 As CartesianPoint
    Set oPoint2 = obj
    IComparable_CompareTo = Sgn(Me.Magnitude - oPoint2.Magnitude)

End Function

Public Function ToString() As String
    ToString = "(" & x & "," & y & ")"
End Function

Public Function Equals(ByVal oPoint2 As CartesianPoint) As Boolean
    Equals = oPoint2.Magnitude = Me.Magnitude
End Function

Private Property Get IToStringable_ToString() As String
    IToStringable_ToString = ToString
End Property

此测试例程提供了示例VBA客户端代码。 SO突出显示lambda字符串。

Public Sub TestObjects2()

    Dim oList As LinqInVBA.ListOfPoints
    Set oList = New LinqInVBA.ListOfPoints

    Dim o(1 To 3) As CartesianPoint
    Set o(1) = New CartesianPoint
    o(1).x = 3: o(1).y = 4

    Set o(2) = New CartesianPoint
    o(2).x = 0.25: o(2).y = 0.5
    Debug.Assert o(2).Magnitude <= 1

    Set o(3) = New CartesianPoint
    o(3).x = -0.25: o(3).y = 0.5
    Debug.Assert o(3).Magnitude <= 1


    oList.Add o(1)
    oList.Add o(2)
    oList.Add o(3)


    Debug.Print oList.ToString2 'prints (3,4),(0.25,0.5),(-0.25,0.5)
    oList.Sort
    Debug.Print oList.ToString2 'prints (-0.25,0.5),(0.25,0.5),(3,4)

    Dim oFiltered As LinqInVBA.ListOfPoints
    Set oFiltered = oList.Where("(o)=>o.Magnitude() <= 1")

    Debug.Print oFiltered.ToString2 'prints (-0.25,0.5),(0.25,0.5)

    Dim oFiltered2 As LinqInVBA.ListOfPoints
    Set oFiltered2 = oFiltered.Where("(o)=>o.AngleInDegrees()>=0 && o.AngleInDegrees()<=90")

    Debug.Print oFiltered2.ToString2 'prints (0.25,0.5)


'    Dim i
'    For i = 0 To oFiltered.Count - 1
'        Debug.Print oFiltered.Item(i).ToString
'    Next i

End Sub

这里给出（缩短的）C＃代码

using System;
using System.Collections.Generic;
using System.Linq;
using System.Linq.Expressions;
using System.Runtime.InteropServices;
using myAlias = System.Linq.Dynamic;   //install package 'System.Linq.Dynamic' v.1.0.7 with NuGet

//https://stackoverflow.com/questions/49453260/datastructure-for-both-sorting-and-filtering/49453892
//https://www.codeproject.com/Articles/17575/Lambda-Expressions-and-Expression-Trees-An-Introdu
//https://stackoverflow.com/questions/821365/how-to-convert-a-string-to-its-equivalent-linq-expression-tree
//https://stackoverflow.com/questions/33176803/linq-dynamic-parselambda-not-resolving
//https://www.codeproject.com/Articles/74018/How-to-Parse-and-Convert-a-Delegate-into-an-Expres
//https://stackoverflow.com/questions/30916432/how-to-call-a-lambda-using-linq-expression-trees-in-c-sharp-net

namespace LinqInVBA
{
    // in project properties, build tab, check the checkbox "Register for Interop", run Visualstudio in admin so it can registers changes 
    // in AssemblyInfo.cs change to [assembly: ComVisible(true)]

    public class LambdaExpressionHelper
    {
        public Delegate ParseAndCompile(string wholeLambda, int expectedParamsCount, Type[] paramtypes)
        {
            string[] split0 = wholeLambda.Split(new string[] { "=>" }, StringSplitOptions.None);
            if (split0.Length == 1) { throw new Exception($"#Could not find arrow operator in expression {wholeLambda}!"); }
            if (split0.Length != 2) { throw new Exception($"#Expecting only single arrow operator not {split0.Length - 1}!"); }

            string[] args = split0[0].Trim().Split(new char[] { '(', ',', ')' }, StringSplitOptions.RemoveEmptyEntries);
            if (args.Length != expectedParamsCount) { throw new Exception($"#Paramtypes array is of different length {expectedParamsCount} to argument list length{args.Length}"); }
            var expression = split0[1];

            List<ParameterExpression> pList = new List<ParameterExpression>();

            for (int lArgLoop = 0; lArgLoop < args.Length; lArgLoop++)
            {
                Type typLoop = paramtypes[lArgLoop];
                var p = Expression.Parameter(typLoop, args[lArgLoop]);
                pList.Add(p);
            }


            var e = myAlias.DynamicExpression.ParseLambda(pList.ToArray(), null, expression);
            return e.Compile();
        }
    }

    public interface IFilterableListOfPoints
    {
        void Add(ICartesianPoint x);
        string ToString2();
        IFilterableListOfPoints Where(string lambda);

        int Count();
        ICartesianPoint Item(int idx);
        void Sort();
    }

    public interface ICartesianPoint
    {
        string ToString();
        double Magnitude();
        double AngleInDegrees();
        // add more here if you intend to use them in a lambda expression
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IFilterableListOfPoints))]
    public class ListOfPoints : IFilterableListOfPoints
    {

        private List<ICartesianPoint> myList = new List<ICartesianPoint>();

        public List<ICartesianPoint> MyList { get { return this.myList; } set { this.myList = value; } }

        void IFilterableListOfPoints.Add(ICartesianPoint x)
        {
            myList.Add(x);
        }

        int IFilterableListOfPoints.Count()
        {
            return myList.Count();
        }

        ICartesianPoint IFilterableListOfPoints.Item(int idx)
        {
            return myList[idx];
        }

        void IFilterableListOfPoints.Sort()
        {
            myList.Sort();
        }

        string IFilterableListOfPoints.ToString2()
        {
            List<string> toStrings = new List<string>();
            foreach (ICartesianPoint obj in myList)
            {
                toStrings.Add(obj.ToString());
            }

            return string.Join(",", toStrings.ToArray());

        }

        IFilterableListOfPoints IFilterableListOfPoints.Where(string wholeLambda)
        {
            Type[] paramtypes = { typeof(ICartesianPoint) };


            LambdaExpressionHelper lh = new LambdaExpressionHelper();
            Delegate compiled = lh.ParseAndCompile(wholeLambda, 1, paramtypes);

            System.Func<ICartesianPoint, bool> pred = (System.Func<ICartesianPoint, bool>)compiled;

            ListOfPoints newList = new ListOfPoints();
            newList.MyList = (List<ICartesianPoint>)myList.Where(pred).ToList();
            return newList;
        }
    }
}

排序和过滤的数据结构

3 个答案:

其他可能性