我正在研究一个包含一系列Microsoft Excel加载项（.xlam）的小项目。此处提交的代码位于
Reflection项目中：
随意评论项目体系结构，但我对
Reflection.LinqEnumerable类最感兴趣。 /> Linq吗？还不完全是linq，但是受System.Linq.Enumerable的启发很大，只有使用Reflection.Delegate类才有可能。我正在研究一个
Grouping类，该类将允许在其中添加GroupBy方法...但是现在，这些是LinqEnumerable类的成员：
对象资源管理器显示了一个迷你文档选择的方法，因为我为每个公共方法都添加了隐藏的
VB_Description属性。这是整个类，具有以下属性：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit
Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean
Dim equatable As IEquatable
If TypeOf value Is IEquatable Then
Set equatable = value
EquateReferenceTypes = equatable.Equals(other)
Else
EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
End If
End Function
Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
EquateValueTypes = (value = other)
End Function
Friend Sub Add(ParamArray values())
Dim valuesArray() As Variant
valuesArray = values
AddArray valuesArray
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
AddArray values.ToArray
End Sub
Friend Sub AddArray(values() As Variant)
Dim value As Variant, i As Long
For i = LBound(values) To UBound(values)
encapsulated.Add values(i)
Next
End Sub
Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0
If IsObject(encapsulated(index)) Then
Set Item = encapsulated(index)
Else
Item = encapsulated(index)
End If
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
Set NewEnum = encapsulated.[_NewEnum]
End Property
Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
Count = encapsulated.Count
End Property
Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
Contains = (IndexOf(value) <> -1)
End Function
Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In encapsulated
If Not result.Contains(value) Then result.Add value
Next
Set Distinct = result
End Function
Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In encapsulated
If Not values.Contains(value) Then result.Add value
Next
Set Except = result
End Function
Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."
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 FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."
Dim result As New LinqEnumerable
result.AddArray values
Set FromArray = result
End Function
Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In values
result.Add value
Next
Set FromCollection = result
End Function
Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
Dim result As LinqEnumerable
Set result = LinqEnumerable.FromArray(value.ToArray)
Set FromEnumerable = result
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
Dim result As New LinqEnumerable
Dim value As Variant
For Each value In values
result.Add value
Next
Set FromList = result
End Function
Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."
Dim result As LinqEnumerable
If index > Count Then Err.Raise 9
Dim lastIndex As Long
lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)
Set result = New LinqEnumerable
Dim i As Long
For i = index To lastIndex
result.Add Item(i)
Next
Set GetRange = result
End Function
Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."
Dim found As Boolean
Dim isRef As Boolean
If Count = 0 Then IndexOf = -1: Exit Function
Dim i As Long
For i = 1 To Count
If IsObject(Item(i)) Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then IndexOf = i: Exit Function
Next
IndexOf = -1
End Function
Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."
If Count = 0 Then Exit Function
If IsObject(Item(Count)) Then
Set Last = Item(Count)
Else
Last = Item(Count)
End If
End Function
Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."
Dim found As Boolean
Dim isRef As Boolean
LastIndexOf = -1
If Count = 0 Then Exit Function
Dim i As Long
For i = 1 To Count
If IsObject(Item(i)) Then
found = EquateReferenceTypes(value, Item(i))
Else
found = EquateValueTypes(value, Item(i))
End If
If found Then LastIndexOf = i
Next
End Function
Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."
Dim result() As Variant
ReDim result(1 To Count)
Dim i As Long
If Count = 0 Then Exit Function
For i = 1 To Count
If IsObject(Item(i)) Then
Set result(i) = Item(i)
Else
result(i) = Item(i)
End If
Next
ToArray = result
End Function
Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."
Dim result As New Scripting.Dictionary
Dim value As Variant
For Each value In encapsulated
If valueSelector Is Nothing Then
result.Add keySelector.Execute(value), value
Else
result.Add keySelector.Execute(value), valueSelector.Execute(value)
End If
Next
Set ToDictionary = result
End Function
Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."
Dim result As New VBA.Collection
Dim value As Variant
For Each value In encapsulated
result.Add value
Next
Set ToCollection = result
End Function
Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."
Dim result As System.List
Set result = List.Create
result.AddArray Me.ToArray
Set ToList = result
End Function
Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."
Dim result As LinqEnumerable
Dim element As Variant
For Each element In encapsulated
If TypeName(element) = value Then result.Add element
Next
Set OfTypeName = result
End Function
Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."
Dim result As New LinqEnumerable
Dim element As Variant
For Each element In encapsulated
result.Add selector.Execute(element)
Next
Set SelectValues = result
End Function
Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."
Dim result As New LinqEnumerable
Dim element As Variant
For Each element In encapsulated
'verbose, but works with anything that supports a For Each loop
Dim subList As Variant
Set subList = selector.Execute(element)
Dim subElement As Variant
For Each subElement In subList
result.Add subElement
Next
Next
Set SelectMany = result
End Function
Public Function Aggregate(ByVal accumulator As Delegate) As Variant
Attribute Aggregate.VB_Description = "Applies an accumulator function over a sequence."
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
Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."
Dim result As 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
Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
If IsObject(element) Then
Set FirstWhere = element
Else
FirstWhere = element
End If
Exit Function
End If
Next
End Function
Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."
Dim result As Variant
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
If IsObject(element) Then
Set result = element
Else
result = element
End If
End If
Next
If IsObject(result) Then
Set LastWhere = result
Else
LastWhere = result
End If
End Function
Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."
Dim result As Long
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then result = result + 1
Next
CountIf = result
End Function
Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."
Dim element As Variant
For Each element In encapsulated
If Not predicate.Execute(element) Then
Exit Function
End If
Next
AllItems = True
End Function
Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."
Dim element As Variant
For Each element In encapsulated
If predicate.Execute(element) Then
AnyItem = True
Exit Function
End If
Next
End Function
请注意，由于语言的限制，我不得不做出一些妥协：
将带有谓词参数的
First的重载重命名为FirstWhere；与Last重载相同，重命名为LastWhere-显然是因为VBA不支持重载。Select重命名为SelectValues，因为“选择”是保留关键字。 /> OfType被重命名为更精确的OfTypeName，因为该函数实际上是在比较类型名称；在VBA中可以进行类型比较，但不能在值类型中进行类型比较-仅比较类型名称并进行验证比较容易。那么，这是LINQ-VBA语言集成查询吗？不确定...但是，这与普通的普通香草
Collection类肯定相距许多步骤。 class =“ lang-none prettyprint-override”> fox brown quick the
#1 楼
分解从
Array和Collection进行翻译时有冗余。考虑这三个片段
Dim value As Variant, i As Long 'value is unused?
For i = LBound(values) To UBound(values)
encapsulated.Add values(i)
Next
Dim value As Variant
For Each value In values
result.Add value
Next
Set result = LinqEnumerable.FromArray(value.ToArray)
它们全部做同样的事情。为什么从
LinqEnumerable转换为Array只是回到LinqEnumerable？当相同的程序对两者都起作用时，为什么有另外一种添加Array或Enumerable的方法呢？鸭式打字是VBA做的少数为数不多的高级功能之一。不使用它真可惜。Private Sub Extend(ByVal sequence As Variant)
Dim element As Variant
For Each element in sequence
encapsulated.Add element
Next element
End Sub
Friend Sub Add(ParamArray values() As Variant)
Extend values
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
Extend values
End Sub
Friend Sub AddArray(values() As Variant)
Extend values
End Sub
' Optional New methods
Friend Sub AddCollection(ByVal values As VBA.Collection)
Extend values
End Sub
Friend Sub AddList(ByVal values As System.List)
Extend values
End Sub
如果要强制执行类型安全性，可以保留它们，但我不会。您需要为要支持的每个其他容器添加两个新方法。老实说，我只转储
Extend和Add并制作Extend Friend，然后仅创建这两个方法。Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."
Dim result As New LinqEnumerable
result.AddCollection values
Set FromCollection = result
End Function
Public Function FromEnumerable(ByVal values As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."
Dim result As LinqEnumerable
result.Concat values
Set FromEnumerable = result
End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
Dim result As New LinqEnumerable
result.AddList values
Set FromList = result
End Function
Public Function FromArray(ByVal values() As Variant) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."
Dim result As New LinqEnumerable
result.AddArray values
Set FromList = result
End Function
#2 楼
您可以伪造重载，这样做将使API更加友好。首先，将FirstWhere和LastWhere设为私有。然后向First和Last添加可选参数。只需检查predicate Is Nothing是否存在，请调用适当的private方法，否则运行返回First / Last的代码。 Public Function First(Optional ByVal predicate As Delegate) As Variant
Attribute First.VB_Description = "Returns the first element in the sequence. If passed a predicate, returns the first element that matches the criteria."
If Not predicate Is Nothing Then
First = FirstWhere(predicate)
Exit Function
End If
If Count = 0 Then Exit Function
If IsObject(Item(1)) Then
Set First = Item(1)
Else
First = Item(1)
End If
End Function
评论
\ $ \ begingroup \ $
我会尝试再回来进行更全面的审查。
\ $ \ endgroup \ $
–RubberDuck
14-10-15在11:49
\ $ \ begingroup \ $
你忘记了吗？里面可能有一笔赏金给您...
\ $ \ endgroup \ $
–马拉奇♦
2014年12月31日15:15
评论
IMO：无论您多么努力，使用VBA都绝对不可能使用LINQ，因为除了类成员之外，这是VBA无法模仿的全新语法和功能，这是LINQ不仅仅是类库的原因之一。 ..也许我只是不称职... :)我认为阻止我的是VBA中没有扩展方法。但是它们只是静态方法调用的语法糖。 LINQ查询语法已编译为方法调用...好吧，在VBA中没有IQueryable ...，但真正的showtopper是延迟执行/延迟评估。还有查询提供程序的概念，因此LINQ to Entities可以吐出T-SQL。我并不是在谈论在VBA中实现所有LINQ ...而是使用Delegate类，现在可以实现大多数System.Linq.Enumerable。可枚举。就在两天前，在VBA中对我来说是不可能的。
如果您使用元数据，@ RezoMegrelidze可以以某种方式将函数作为参数传递。例如，按功能名称命名为Application.Run或UDF hack
VBA没有函数指针并不完全正确。他们只是没有得到很好的支持。 AddressOf返回一个带符号的4字节整数值，该整数值表示指定proc的地址，但是我不确定您是否想在该兔子洞中钻下去。
凡将此代码与AddressOf配合使用的人，将获得额外的顶级奖励。