函数调用代码 VBA

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:A100) 中的第一个单元格 (A1) 相关
  • 即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. 获取每个属性名称的字符串值，
2. 记录评估并最终将其作为字符串运行，
3. 拥有对属性的智能感知访问权限，并且
4. 能够在每次迭代中调试评估。

关于 #1 和 #3，在 VBA 中执行此操作的唯一方法是手动编码值。如果你在你的类中编写它们，那么类可能会变得很麻烦，有些人可能会说它损害了单一责任原则 (https://en.wikipedia.org/wiki/Single_responsibility_principle)。如果您将它们编码在一个单独的“容器”（例如类、类型、集合等）中，那么如果您更改属性名称，则存在丢失某些内容或损坏的风险。一个接口类可能会缓解这些问题。

对于#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 类

最后一个类实际上只是一个帮助类，用于创建您需要的智能感知语法并处理评估。这绝不是彻底的，但如果这个想法对你有吸引力，可能会让你开始。我称这个类为 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