问题

Question

问题

如果您想直接查看UDF的参数（不是它们的值，可以直接传递，而是公式提供这些值），可以使用Application.Caller.Formula并解析出查找的参数。

有没有办法看到调用函数的VBA代码行，以便你可以用类似的方式解析它的参数？

背景

前一段时间我创建了一个UDF，它本质上是另一种数组函数*的方法。我想做的是采取一些评估为True / False

的陈述

LEN(A1)>LEN(B1)

并通过数组进行评估。所以说上面的函数放在单元格A1中，然后评估数组A1:A100将与创建数组相同

{LEN(A1)>LEN(B1),LEN(A2)>LEN(B2),[...]} 'you may recognise this as an array formula ={LEN(A1:A100)>LEN(B1:B100)}

* 对于上下文，这是在我了解数组公式之前

我对某些数组处理Excel函数的语法感到沮丧，例如COUNTIF，它采用以下形式的参数

COUNTIF(range_To_Evalueate_Over, "string_Representing_Boolean_Test")

字符串参数显示以下限制

没有任何布尔返回语句可以用作测试;没有办法查看您评估的范围的属性而不是它们的值
- 因此，您无法使用LEN（）等函数来获取有关范围的更多数据
- 您无法引用相对于范围的其他单元格（如B1相对于A1）
字符串在运行时是静态的，您不能逐步进入函数以查看字符串将从您正在评估的范围内为给定单元格评估的内容

我更喜欢条件格式化公式的多功能性。它们采用数组公式的形式，其中任何偏移量（B1相对于A1）都是相对于应用条件格式的范围的TL单元格计算的。

这促使我创建了一个具有类似结构的UDF

evaluateOverRange(range_to_evalute_over As Range, boolean_test_on_TL_Cell As Boolean) As Boolean() 'returns an array equal in size to the evaluate range

像

一样使用

evaluateOverRange(A1:A100,LEN(A1)<LEN(B1))

请注意

布尔测试不是字符串，因此可以在Excel中逐步评估
由于类型声明
布尔测试相对于评估范围（A1）中的第一个单元格（A1:A100）
- 即。 B1替换为A1.Offset(0,1)
由于boolean_test_on_TL_Cell不是字符串，它不会告诉我们实际的测试，它只是将测试结果传递给A1，它在UDF中实际上是无用的，因此被忽略
- 要获取测试字符串"LEN(A1)<LEN(B1)"，将读取Application.Caller.Formula，并解析evaluateOverRange的相关参数

为了评估VBA中数组的某些工作表函数，可以使用Evaluate方法

Dim colA As Range: Set colA = [A1:A100] 'range_to_evaluate_over in my udf
Dim cellA As Range
Dim cellB as Range
Dim outputArray(1 To 100) As Boolean

For i = 1 To 100
    Set cellA = colA(i)
    Set cellB = cellA.Offset(0,1) 'all cells that arent the TL cell in colA (i.e., not A1) are set relative to the top left cell
    outputArray(i) = Evaluate("LEN(" & cellA.Value & ")>LEN(" & cellB.Value ")")
Next i

是的，所有这些都是针对工作表函数的，而且在给定数组函数方面有点无意义也是如此。但现在我想在VBA中使用相同的方法。

具体来说，我想基于其属性的某些功能过滤自定义类的数组，使用实际的VBA布尔返回代码而不是字符串。

Sub FilterMyClassArray() 'Prints how many items in arrayToFilter whose properties match certain conditions
    Dim arrayToFilter(1 To 100) As New myClass
    Dim filteredArray() As myClass 
    Dim tlClass As myClass 'pretend class used only for intellisense and to create 
boolean test
    Set filteredArray = filterClassArray(arrayToFilter, tlClass.PropertyA > 3 And 
   tlClass.PropertyB = "hat")
   Debug.Print "Number left after filtering:" ; Ubound(filteredArray)
End Sub

Function filterClassArray(ByVal inutArray() As myClass, classTest As Boolean) As myClass 'returns an output array which is equal to the input array filtered by some test
'Somehow get what classTest actually was
'Evaluate classTest over each item in inputArray
'If boolean test evaluates to true, add to output array, otherwise skip
End Function

我想要对代码模块进行一些操作（两者都是为了获得代表测试的代码字符串，并实际评估它），但我想在深挖之前检查可行性。

Answer 1

我一直在考虑这个问题，如果您准备使用近似Linq语法的内容，可能会有一个解决方案。

如果我理解正确的要求，您需要：

获取每个属性名称的字符串值
记录评估并最终将其作为字符串运行，
具有智能感知权限，
能够在每次迭代时调试评估。

关于＃1和＃3，在VBA中执行此操作的唯一方法是手动编码值。如果您在课堂上对它们进行编码，那么该课程可能会变得很麻烦，有些人可能会说它会影响单一责任原则（https://en.wikipedia.org/wiki/Single_responsibility_principle）。如果您在单独的“容器”（例如，类，类型，集合等）中对它们进行编码，那么如果更改属性名称，则存在丢失或损坏的风险。 Interface类可以缓解这些问题。

对于＃2，我看不到任何方法：评估必须以字符串形式输入。枚举（和相关的智能感知）可能会缓解一些事情。

第4项纯粹是编码架构问题。

首先是语法

我确信互联网上有VBA解决方案可以实现Linq相当不错的模型，但更进一步的是一个骨架版本给你的想法。最终结果是您的查询语法如下所示：

Dim query As cLinq
Dim p As INameable
Dim arrayToFilter(1 To 100) As INameable
Dim filteredArray() As INameable

Set query = New cLinq
With query
    .SELECT_USING_INTERFACE p
    .FROM arrayToFilter
    .WHERE p.PropertyA, EQUAL_TO, 3
    .AND_WHERE p.PropertyB, EQUAL_TO, "hat"
    filteredArray = .EXECUTE
End With

界面

就VBA而言，接口实际上只是一个类模块，其中包含您希望类实现的属性和方法列表。在您的情况下，我创建了一个类并将其命名为 INameable ，并使用以下示例代码来匹配您的示例：

Option Explicit

Public Property Get PropertyA() As Long
End Property
Public Property Let PropertyA(RHS As Long)
End Property
Public Property Get PropertyB() As String
End Property
Public Property Let PropertyB(RHS As String)
End Property

您的MyClass类然后实现此接口。为了保持一致性，我调用了类 cMyClass ：

Option Explicit
Implements INameable

Private mA As Long
Private mB As String

Private Property Let INameable_PropertyA(RHS As Long)
    mA = RHS
End Property

Private Property Get INameable_PropertyA() As Long
    INameable_PropertyA = mA
End Property

Private Property Let INameable_PropertyB(RHS As String)
    mB = RHS
End Property

Private Property Get INameable_PropertyB() As String
    INameable_PropertyB = mB
End Property

我已经创建了第二个类，名为cNames，它也实现了接口，并且这个类生成了属性的字符串名称。作为一种快速而肮脏的方法，它只存储最后使用的属性的名称：

Option Explicit
Implements INameable

Private mName As String

Private Property Let INameable_PropertyA(RHS As Long)
End Property

Private Property Get INameable_PropertyA() As Long
    mName = "PropertyA"
End Property

Private Property Let INameable_PropertyB(RHS As String)
End Property

Private Property Get INameable_PropertyB() As String
    mName = "PropertyB"
End Property

Public Property Get CurrentName() As String
    CurrentName = mName
End Property

您不必使用界面，有些人可能认为这样做没有必要甚至不正确，但至少它可以让您了解如果您走这条路线可以如何实施。

Linq课程

最后一个类实际上只是一个辅助类，用于创建所需的intellisense语法并处理评估。这绝不是彻底的，但如果这个想法吸引你，可能会让你开始。我把这个类称为 cLinq ：

Option Explicit
'Enumerator to help with intellisense.
Public Enum Operator
    EQUAL_TO
    GREATER_THAN
    LESS_THAN
    GREATER_OR_EQUAL_TO
    LESS_OR_EQUAL_TO
    NOT_EQUAL_TO
End Enum

Private mP As cNames
Private mQueries As Collection
Private mByAnd As Boolean
Private mFromArray As Variant
Public Sub SELECT_USING_INTERFACE(p As INameable)
    'Insantiate the name of properties class.
    Set mP = New cNames
    Set p = mP
End Sub
Public Sub FROM(val As Variant)
    'Array containing objects to be interrogated.
    mFromArray = val
End Sub
Public Sub WHERE(p As Variant, opr As Operator, val As Variant)
    'First query.
    Set mQueries = New Collection
    AddQuery opr, val
End Sub
Public Sub AND_WHERE(p As Variant, opr As Operator, val As Variant)
    'Subsequent query using AND.
    mByAnd = True
    AddQuery opr, val
End Sub
Public Sub OR_WHERE(p As Variant, opr As Operator, val As Variant)
    'Subsequent query using OR.
    mByAnd = False
    AddQuery opr, val
End Sub
Public Function EXECUTE() As Variant
    Dim o As Object
    Dim i As Long
    Dim result As Boolean
    Dim matches As Collection
    Dim output() As Object

    'Iterate the array of objects to be checked.
    Set matches = New Collection
    For i = LBound(mFromArray) To UBound(mFromArray)
        Set o = mFromArray(i)
        result = EvaluatedQueries(o)
        If result Then matches.Add o
    Next

    'Transfer matched objects to an array.
    ReDim output(0 To matches.Count - 1)
    i = LBound(output)
    For Each o In matches
        Set output(i) = o
        i = i + 1
    Next

    EXECUTE = output
End Function
Private Function EvaluatedQueries(o As Object) As Boolean
    Dim pep As Variant, val As Variant
    Dim evalString As String
    Dim result As Boolean

    For Each pep In mQueries
        'Obtain the property value by its string name
        val = CallByName(o, pep(0), VbGet)
        'Build the evaluation string.
        evalString = ValToString(val) & pep(1)
        'Run the evaluation
        result = Evaluate(evalString)
        'Exit the loop if AND or OR conditions are met.
        If mQueries.Count > 1 Then
            If (mByAnd And Not result) Or (Not mByAnd And result) Then Exit For
        End If
    Next

    EvaluatedQueries = result
End Function
Private Sub AddQuery(opr As Operator, val As Variant)
    Dim pep(1) As Variant

    'Create a property/evaluation pair and add to collection,
    'eg pep(0): "PropertyA", pep(1): " = 3"
    pep(0) = mP.CurrentName
    pep(1) = OprToString(opr) & ValToString(val)
    mQueries.Add pep
End Sub
Private Function OprToString(opr As Operator) As String
    'Convert enum values to string operators
    Select Case opr
        Case EQUAL_TO
            OprToString = " = "
        Case GREATER_THAN
            OprToString = " > "
        Case LESS_THAN
            OprToString = " < "
        Case GREATER_OR_EQUAL_TO
            OprToString = " >= "
        Case LESS_OR_EQUAL_TO
            OprToString = " <= "
        Case NOT_EQUAL_TO
            OprToString = " <> "
    End Select
End Function
Private Function ValToString(val As Variant) As String
    Dim result As String

    'Add inverted commas if it's a string.
    If VarType(val) = vbString Then
        result = """" & val & """"
    Else
        result = CStr(val)
    End If

    ValToString = result
End Function

函数调用者代码VBA

问题

背景

1 个答案: