Excel 和 VBA - 直接查询 ListObject

• 下载测试工作簿 (Revised).zip - 196 KB

引言

    如果您花了很多时间在数据分析领域，您很可能会以某种方式使用 Excel。  当您需要快速整合数据时，有时 Excel 能提供最快的方式从点 A 到点 B。  您可以启动一个 SQL 服务器之类的东西，但如果您是在从数据存储中提取数据后与数据交互，或者您没有这些工具，有时您就必须凑合着用您手头的东西。

这就是查询 ListObjects 的用武之地。  Excel 2007+ 为我们提供了表格，这简化了 Excel 公式（因为您不再处理 $A$2:$A$403，而是使用 TableName[ColumnName] 并且范围会自动更新以适应扩展）的整合。

    您可以在原地过滤您的表格，但如果您需要对该数据的子集进行操作，隐藏列、行、复制可见内容、创建新的工作表/工作簿等等可能会变得非常繁琐；尤其是当某些过滤器变得复杂时。

背景

    如果您之前使用过查询语言，您就会知道它们提供了一种方便的方式来从预先存在的来源收集数据。  您了解结构，并且它相当稳定，结果使您能够进行进一步的处理。

    这里介绍的是 Excel 中伪查询的第一步，它还不能执行 JOIN，但随着时间的推移可能会发展到那个阶段。  在 VBA 中编写查询而不是通过 ADO 加载表结构的一个好处是智能感知（intellisense）。

代码解析

    提供的示例有点牵强，由于这种基础设施的复杂性，它被自动化了。

    未包含的是一个“非常隐藏”的 <Document_Structure> 工作表，它有助于（相当愚蠢的）重构过程。  在我这边，当列、表或工作表重命名时，它会利用这个“先前状态”来知道它以前是什么，以便移动到它现在是什么。它不处理重叠的上下文，所以如果我有一个与列同名的表，如果其中一个被重命名，它稍后可能会失败。  这个功能被删除了，因为它与文章的重点无关，只是使文件变大了。

    进入代码，设置一个真正的类查询语法是一项相当复杂的任务，但一旦自动化，我相信结果是值得付出的努力的。  为了在此模型中提供相当有用的智能感知，与行和列的交互已被简化。  让我们从整体示例模型概述开始。

• ExampleData
• ListOrderingTable
• ListOrderingTableRow
• ListOrderingTableRows
• OrderDetailsData
• OrderDetailsQuery
• OrderDetailsQueryCondition
• OrderDetailsQueryHead
• OrderDetailsQueryOpPart
• OrderDetailsQueryOrderByParent
• OrderDetailsQueryOrderByPart
• OrderDetailsQueryPart
• OrderDetailsSelectParent
• OrderDetailsSelectPart
• OrderingTableOrderByBuilder
• OrderingTableQuery
• OrderingTableQueryBuilder
• OrderingTableSelectBuilder
• OrderingTableWhereBuilder

    您可以看到，这是一个艰巨的任务！

    就像任何事情一样，无论大小，分解后就会变得更容易。

    ExampleData - VBA 项目中关键的主工作表称为“Example”。  ExampleData 是代表其关注数据点的类。在这种情况下，它维护一个名为 OrderingTable 的属性，类型为 ListOrderingTable。  在工作表方面，实际的表格正如您所料，名为“OrderingTable”。

   您的第一个问题可能是：为什么还要维护一个与实际工作表分开的类数据？

    如果您像我一样处理了很多 Excel 数据，您就会明白有时您可能希望您的代码与数据分开。  所以在这种情况下，如果我构建了模型，我可能想在一个*单独的*工作簿，或多个共享通用数据模型的工作簿上操作。

    举个例子：检查给定工作簿的自动化模型会注入自己的状态跟踪工作表。  如果我将其嵌入工作表中，我就失去了实例化并关联到不同数据源的能力。

回到数据，ListOrderingTable 维护着实际工作表中出现的列。

ID	名称	描述	类别	价格	数量	总价

    ListOrderingTable 上的属性如下：

Public Property Get ID() As ListColumn
    Set ID = Source.ListColumns("ID")
End Property

Public Property Get Name() As ListColumn
    Set Name = Source.ListColumns("Name")
End Property

Public Property Get Description() As ListColumn
    Set Description = Source.ListColumns("Description")
End Property

Public Property Get Category() As ListColumn
    Set Category = Source.ListColumns("Category")
End Property

Public Property Get Price() As ListColumn
    Set Price = Source.ListColumns("Price")
End Property

Public Property Get Quantity() As ListColumn
    Set Quantity = Source.ListColumns("Quantity")
End Property

Public Property Get TotalCost() As ListColumn
    Set TotalCost = Source.ListColumns("Total Cost")
End Property

    这些在查询的匹配部分稍后会被引用。

    此自定义结构中的行也模仿了上述结构。  它们为每列提供了一个调用点，并返回一个范围，这简化了使用迭代方法审问这些对象的工作。  这是在创建查询之前构建的垫脚石。

    查询的核心存在于 OrderDetailsQuery 中，它根据 Query Builders 提供的信息构建实际的查询。  之所以要分离关注点，是因为：如果我有多个表格想要提供查询，重复编写代码只会进一步臃肿文档。

    让我们来看一个在我们测试数据上的示例查询。

    Set otQuery = _
        DataModel.QueryExample.OrderingTable.GetQueryBuilder() _
            .Where(OD_OTC_ID, OD_MC_GreaterThan, 10000) _
                .AndAlso(OD_OTC_ID, OD_MC_LessThan, 40000) _
                .AndAlso(OD_OTC_Name, OD_MC_DoesNotStartWith, "Mashed") _
            .OrElse(OD_OTC_Name, OD_MC_Contains, "Mashed") _
                .AndAlsoOpenParen(OD_OTC_Price, OD_MC_LessThan, 4) _
                    .OrElse(OD_OTC_Price, OD_MC_GreaterThan, 7) _
                .CloseParen() _
            .OrderBy(OD_OTC_ID, OD_OD_Ascending) _
            .SelectColumn(OD_OTC_ID) _
                .AndAlso(OD_OTC_Name) _
                .AndAlso(OD_OTC_Price) _
                .AndAlso(OD_OTC_Quantity) _
                .AndAlso(OD_OTC_TotalCost).Build

    一旦您习惯了忽略 OD_OTC_、OD_MC_ 和 OD_OD_ 部分，这就相当直接了。  查询基本上是在查找表中 ID 大于 10000 且小于 40000 并且名称不以“Mashed”开头；或者包含“Mashed”且价格小于 4 或大于 7 的项目。  然后按 ID 升序排序，结果包含 ID、名称、价格、数量和总价。

    虽然自己遍历数据可以很容易地提取匹配项，但构建查询模型可以使添加、删除、排序和更改条件变得极其简单。  添加的智能感知是一个额外的奖励。

    “QueryBuilder”的目的是简化为构建查询收集必要信息的过程。  这是在不持续重建底层状态机的情况下做到这一点最有效的方法。  这也是为什么“Build”会被显式调用的原因。  如果您“SelectAll”，则构建方法是不必要的。

---

    现在我们有了查询，让我们看一下“Build”方法，它分为三个步骤，从 OrderingTableSelectBuilder 上的 Build 开始。

Public Function Build() As OrderingTableQuery
    Dim m_qry_Result As OrderingTableQuery
    Set m_qry_Result = New OrderingTableQuery
    m_qry_Result.Build Me
    Set Build = m_qry_Result
End Function

    然后是 OrderingTableQuery 上的 Build。

Friend Sub Build(vTarget As Variant)
    Set m_qry_Query = New OrderDetailsQuery
    Set m_lst_Source = m_qry_Query.Build(vTarget)
End Sub

    最后是 OrderDetailsQuery。

Friend Function Build(target As Variant) As Variant
    Dim m_int_Index As Integer
    Dim m_col_Leafs As Collection
    Dim m_col_Orderings As Collection
    Dim m_col_Selects As Collection
    Dim m_col_Actions As Collection
    Dim m_var_Current As Variant
    Dim m_int_ParenLevel As Integer
    Dim m_qop_Part As OrderDetailsQueryOpPart
    Dim m_qpt_Part As OrderDetailsQueryPart
    Dim m_var_Source As Variant
    Set m_var_Source = Nothing
    If Not IsObject(target) Then _
        Exit Function
    Set m_col_Leafs = New Collection
    Set m_col_Orderings = New Collection
    Set m_col_Selects = New Collection
    Set m_col_Actions = New Collection
    Set m_var_Current = target
    While Not m_var_Current Is Nothing
        If TypeOf m_var_Current Is OrderDetailsSelectPart Then
            m_int_ParenLevel = 0
            Dim m_spt_Select As OrderDetailsSelectPart
            Set m_spt_Select = m_var_Current
            If m_col_Selects.Count = 0 Then
                m_col_Selects.Add m_spt_Select
            Else
                m_col_Selects.Add m_spt_Select, , 1
            End If
            Set m_var_Current = m_spt_Select.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryOrderByPart Then
            m_int_ParenLevel = 0
            Dim m_obp_OrderBy As OrderDetailsQueryOrderByPart
            Set m_obp_OrderBy = m_var_Current
            If m_col_Orderings.Count = 0 Then
                m_col_Orderings.Add m_obp_OrderBy
            Else
                m_col_Orderings.Add m_obp_OrderBy, , 1
            End If
            Set m_var_Current = m_obp_OrderBy.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryOpPart Then
            Set m_qop_Part = m_var_Current
            If Not m_qop_Part.InitialCondition Is Nothing Then
                If m_col_Leafs.Count = 0 Then
                    m_col_Leafs.Add m_qop_Part.InitialCondition
                Else
                    m_col_Leafs.Add m_qop_Part.InitialCondition, , 1
                End If
            End If
            If m_col_Actions.Count = 0 Then
                m_col_Actions.Add m_qop_Part.Action
            Else
                m_col_Actions.Add m_qop_Part.Action, Before:=1
            End If
            m_int_ParenLevel = 0
            Set m_var_Current = m_qop_Part.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryHead Then
            Dim m_qrh_Head As OrderDetailsQueryHead
            Set m_qrh_Head = m_var_Current
            If Not IsEmpty(m_qrh_Head.Source) And IsObject(m_qrh_Head.Source) Then
                Set m_var_Source = m_qrh_Head.Source
            End If
            Set m_var_Current = Nothing
        End If
    Wend
    If m_col_Actions.Count > 0 Then
        m_col_Actions.Add OD_QueryPartAction.OD_QPA_Finish
        Dim m_qpa_Actions() As OD_QueryPartAction
        Dim m_cnd_Conditions() As OrderDetailsQueryCondition
        ReDim m_qpa_Actions(1 To m_col_Actions.Count)
        ReDim m_cnd_Conditions(1 To m_col_Leafs.Count)
    End If
    If m_col_Selects.Count > 0 Then
        m_int_SelectCount = m_col_Selects.Count
        ReDim m_ina_Selects(1 To m_int_SelectCount)
        For m_int_Index = 1 To m_col_Selects.Count
            Set m_spt_Select = m_col_Selects(m_int_Index)
            m_ina_Selects(m_int_Index) = m_spt_Select.Column
        Next
    Else
        m_int_SelectCount = 0
    End If
    If m_col_Orderings.Count > 0 Then
        m_int_OrderingCount = m_col_Orderings.Count
        ReDim m_ina_OrderingColumns(1 To m_int_OrderingCount)
        ReDim m_oda_OrderingDirections(1 To m_int_OrderingCount)
        For m_int_Index = 1 To m_int_OrderingCount
            Set m_obp_OrderBy = m_col_Orderings(m_int_Index)
            m_oda_OrderingDirections(m_int_Index) = m_obp_OrderBy.Direction
        Next
    Else
        m_int_OrderingCount = 0
    End If
    For m_int_Index = 1 To m_col_Actions.Count
        m_qpa_Actions(m_int_Index) = m_col_Actions(m_int_Index)
    Next
    For m_int_Index = 1 To m_col_Leafs.Count
        Set m_cnd_Conditions(m_int_Index) = m_col_Leafs(m_int_Index)
    Next
    Dim m_col_References As Collection
    Dim m_cnd_Current As OrderDetailsQueryCondition
    Dim m_int_ColumnIndex As Integer
    Dim m_int_CurrentTarget As Integer
    If m_col_Actions.Count > 0 Then
        ReDim m_ina_CriteriaTargets(1 To m_col_Leafs.Count)
        ReDim m_ina_FailJumps(1 To m_col_Leafs.Count)
        ReDim m_ina_PassJumps(1 To m_col_Leafs.Count)
        ReDim m_mca_Criteria(1 To m_col_Leafs.Count)
        ReDim m_vra_RHSCriteria(1 To m_col_Leafs.Count)
    End If
    Set m_col_References = New Collection
    For m_int_Index = 1 To m_col_Leafs.Count
        Set m_cnd_Current = m_col_Leafs(m_int_Index)
        m_mca_Criteria(m_int_Index) = m_cnd_Current.Operator
        If IsObject(m_cnd_Current.Value) Then
            Set m_vra_RHSCriteria(m_int_Index) = m_cnd_Current.Value
        Else
            m_vra_RHSCriteria(m_int_Index) = m_cnd_Current.Value
        End If
        Dim m_int_TargetIndex As Integer
        Dim m_boo_ColumnPresent As Boolean
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentTarget = m_cnd_Current.Column Then
                m_int_ColumnIndex = m_int_TargetIndex
                m_boo_ColumnPresent = True
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_cnd_Current.Column
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_CriteriaTargets(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_CriteriaReferenceCount = m_col_References.Count
    For m_int_Index = 1 To m_col_Orderings.Count
        Set m_obp_OrderBy = m_col_Orderings(m_int_Index)
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentTarget = m_obp_OrderBy.Column Then
                m_int_ColumnIndex = m_int_TargetIndex
                m_boo_ColumnPresent = True
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_obp_OrderBy.Column
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_OrderingColumns(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_AdditionalOrderingReferenceCount = m_col_References.Count - m_int_CriteriaReferenceCount
    For m_int_Index = 1 To m_col_Selects.Count
        Dim m_int_CurrentSelectColumn As Integer
        m_int_CurrentSelectColumn = m_ina_Selects(m_int_Index)
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentSelectColumn = m_int_CurrentTarget Then
                m_boo_ColumnPresent = True
                m_int_ColumnIndex = m_int_TargetIndex
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_int_CurrentSelectColumn
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_Selects(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_AdditionalSelectReferenceCount = m_col_References.Count - (m_int_CriteriaReferenceCount + m_int_AdditionalOrderingReferenceCount)
    m_int_ReferencedColumnCount = m_col_References.Count
    ReDim m_ina_Type(1 To m_int_ReferencedColumnCount)
    For m_int_Index = 1 To m_int_ReferencedColumnCount
        m_ina_Type(m_int_Index) = m_col_References(m_int_Index)
    Next
    If m_col_Actions.Count > 0 Then
        BuildQueryLogicalOrLeafs m_cnd_Conditions, m_qpa_Actions, 1, m_col_Actions.Count, 0, 0
    End If
    Set Build = m_var_Source
End Function

    正如您所见，它采取的第一步是解构查询构建器，从最右边的节点一直到查询构建器头部。  当查询中存在条件时，它就知道从最高阶组件“OrElse”开始构建查询。  在普通语言中，这将是最高阶的优先级（或最后评估点，取决于您如何看待它）。

    您会注意到大部分内容仅关注引用跟踪。  为了避免在查询评估期间多次加载同一列，它会将所有内容重新索引到一个基线。  因此，如果 Select、Orderby 和 Where 都引用 ID，它们都将使用相同的索引，从一 (1) 到引用的总数。

    从“OrElse”运算符开始，让我们看看它在做什么。

Private Sub BuildQueryLogicalOrLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_col_OrPoints As Collection
    Dim m_int_Index As Integer
    Dim m_int_ParenDepth As Integer
    Dim m_boo_AddingOr As Boolean
    Dim m_int_CurrentStart As Integer
    Dim m_int_CurrentEnd As Integer
    Set m_col_OrPoints = New Collection
    If iStart <> iEnd Then
        For m_int_Index = iStart To iEnd - 1
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                Case OD_QPA_OrElse
                    If m_int_ParenDepth = 0 Then _
                        m_col_OrPoints.Add m_int_Index
            End Select
        Next
    End If
    m_int_CurrentStart = iStart
    If m_col_OrPoints.Count = 0 Then
        m_int_CurrentEnd = iEnd
        BuildQueryLogicalAndLeafs cndConditions, qpaActions, CorrectTarget(m_int_CurrentStart, qpaActions), CorrectTarget(m_int_CurrentEnd, qpaActions), iFailTarget, iPassTarget
    Else
        For m_int_Index = 1 To m_col_OrPoints.Count
            m_int_CurrentEnd = m_col_OrPoints(m_int_Index)
            Dim m_int_CorrectedFailTarget As Integer
            m_int_CorrectedFailTarget = CorrectTarget((m_int_CurrentEnd + 1) + CorrectJumpTarget(qpaActions, m_int_CurrentEnd + 1) - CorrectJumpTarget(qpaActions, m_int_CurrentEnd), qpaActions)
            While qpaActions(m_int_CorrectedFailTarget) = OD_QPA_CloseParenPadding Or qpaActions(m_int_CorrectedFailTarget) = OD_QPA_CloseParen
                m_int_CorrectedFailTarget = m_int_CorrectedFailTarget + 1
                If m_int_CorrectedFailTarget > UBound(qpaActions) Then
                    m_int_CorrectedFailTarget = UBound(qpaActions)
                    GoTo ExitWend
                End If
            Wend
ExitWend:
            BuildQueryLogicalAndLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, m_int_CorrectedFailTarget, iPassTarget
            m_int_CurrentStart = m_int_CurrentEnd + 1
        Next
        m_int_CurrentEnd = iEnd
        BuildQueryLogicalAndLeafs cndConditions, qpaActions, CorrectTarget(m_int_CurrentStart, qpaActions), CorrectTarget(m_int_CurrentEnd, qpaActions), iFailTarget, iPassTarget
    End If
End Sub

    然后进入 AndAlso。

Private Sub BuildQueryLogicalAndLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_col_AndPoints As Collection
    Dim m_int_Index As Integer
    Dim m_int_ParenDepth As Integer
    Dim m_int_CurrentStart As Integer, _
        m_int_CurrentEnd   As Integer
    Dim m_int_EndAdjusted As Integer
    Set m_col_AndPoints = New Collection
    If iStart <> iEnd Then
        For m_int_Index = iStart To iEnd - 1
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                Case OD_QPA_AndAlso
                    If m_int_ParenDepth = 0 Then _
                        m_col_AndPoints.Add m_int_Index
            End Select
        Next
    End If
    If m_col_AndPoints.Count = 0 Then
        If qpaActions(iStart) = OD_QPA_OpenParen Then
            BuildQueryLogicalParenLeafs cndConditions, qpaActions, iStart, iEnd, iFailTarget, iPassTarget
        Else
            'When we're nested as deep as we can go...
            m_int_EndAdjusted = iEnd - CorrectJumpTarget(qpaActions, iEnd)
            
            m_ina_FailJumps(m_int_EndAdjusted) = iFailTarget - CorrectJumpTarget(qpaActions, iFailTarget)
            m_ina_PassJumps(m_int_EndAdjusted) = iPassTarget - CorrectJumpTarget(qpaActions, iPassTarget)
        End If
    Else
        m_int_CurrentStart = iStart
        For m_int_Index = 1 To m_col_AndPoints.Count
            m_int_CurrentEnd = m_col_AndPoints(m_int_Index)
            Dim m_int_CorrectedPassTarget As Integer
            m_int_CorrectedPassTarget = CorrectTarget((m_int_CurrentEnd + 1) + CorrectJumpTarget(qpaActions, m_int_CurrentEnd + 1) - CorrectJumpTarget(qpaActions, m_int_CurrentEnd), qpaActions)
            While qpaActions(m_int_CorrectedPassTarget) = OD_QPA_CloseParenPadding Or qpaActions(m_int_CorrectedPassTarget) = OD_QPA_CloseParen
                m_int_CorrectedPassTarget = m_int_CorrectedPassTarget + 1
                If m_int_CorrectedPassTarget > UBound(qpaActions) Then
                    m_int_CorrectedPassTarget = UBound(qpaActions)
                    GoTo ExitWend
                End If
            Wend
ExitWend:
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, m_int_CorrectedPassTarget
            m_int_CurrentStart = m_int_CurrentEnd + 1
        Next
        m_int_CurrentEnd = iEnd
        If qpaActions(m_int_CurrentStart) = OD_QPA_OpenParen Then
            BuildQueryLogicalParenLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, iPassTarget
        Else
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, iPassTarget
        End If
    End If
End Sub

    最后是最低阶（或第一）运算符，括号。

Private Sub BuildQueryLogicalParenLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_int_ParenDepth As Integer
    Dim m_int_Index As Integer
    Dim m_int_ZeroPoint As Integer
    If qpaActions(iStart) = OD_QPA_OpenParen Then
        For m_int_Index = iStart To iEnd
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                    If m_int_ParenDepth = 0 Then
                        m_int_ZeroPoint = m_int_Index
                        Exit For
                    End If
            End Select
        Next
        If m_int_ParenDepth <= 0 Then
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, iStart + 1, m_int_ZeroPoint - 1, iFailTarget, iPassTarget
        End If
    End If
End Sub

    您会注意到 QPA（查询部分操作）散布各处，本质上，构建器正在合成常量，这些常量实际上代表了一串运算符。  将该流与操作数分离的早期设计选择导致了奇怪的“CloseParenPadding”以及纠正跳转目标的需求。

    在此查询状态机的上下文中，跳转目标指的是如何实现短路。  我选择了“AndAlso”和“OrElse”这两个词，因为它们存在于 VB.NET 中，并且具有预期的目标：仅评估到所需程度。

    在下面的 match 方法中，您会注意到每行的匹配仅仅是一组跳转目标，这些目标根据条件是否满足而被使用。  如果满足，则跳转到“p”条件，或跳转到“f”条件（表示失败）。  当任一指令指示跳转到零条件时，它要么完全通过匹配，要么未能匹配。

Friend Function MatchInternal(ByRef lCount As Long, vraDataSource() As Variant, qOperation As OD_QueryOperation) As Variant
    Dim m_lna_MatchingLines() As Long
    Dim m_lng_MatchingLineDimension As Long
    Dim m_lng_MatchingLineCount As Long
    Dim m_lng_LineIndex As Long
    Dim m_var_CurrentLHS As Variant, _
        m_var_CurrentRHS As Variant
    Dim m_boo_LastIsMatch As Boolean
    Dim m_var_BetMin As Variant
    Dim m_var_BetMax As Variant
    Dim m_var_CurrentRHSElement As Variant
    Dim m_lng_NewMatchLength As Long
    Dim m_int_Ordering As Long
    If m_int_CriteriaReferenceCount <> 0 Then
        m_lng_MatchingLineDimension = 4
        ReDim m_lna_MatchingLines(1 To m_lng_MatchingLineDimension)
        '**********************************
        ' Go through each line, on each go
        ' through the full criteria; with
        ' exception to terminal edges which
        ' yield a pass or fail.
        '**********************************
        For m_lng_LineIndex = 1 To lCount
            Dim m_int_CriteriaID As Long
            m_int_CriteriaID = 1
            While m_int_CriteriaID <> 0
                m_boo_LastIsMatch = False
                If lCount = 1 Then
                    m_var_CurrentLHS = vraDataSource(m_ina_CriteriaTargets(m_int_CriteriaID))
                Else
                    m_var_CurrentLHS = vraDataSource(m_ina_CriteriaTargets(m_int_CriteriaID))(m_lng_LineIndex, 1)
                End If
                m_var_CurrentRHS = m_vra_RHSCriteria(m_int_CriteriaID)
                Select Case m_mca_Criteria(m_int_CriteriaID)
                    Case OD_MC_HasFlag
                        m_boo_LastIsMatch = (m_var_CurrentLHS And m_var_CurrentRHS) = m_var_CurrentRHS
                    Case OD_MC_NotHasFlag
                        m_boo_LastIsMatch = (m_var_CurrentLHS And m_var_CurrentRHS) <> m_var_CurrentRHS
                    Case OD_MC_EqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS = m_var_CurrentRHS
                    Case OD_MC_LessThan
                        m_boo_LastIsMatch = m_var_CurrentLHS < m_var_CurrentRHS
                    Case OD_MC_GreaterThan
                        m_boo_LastIsMatch = m_var_CurrentLHS > m_var_CurrentRHS
                    Case OD_MC_GreaterThanOrEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS >= m_var_CurrentRHS
                    Case OD_MC_LessThanOrEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS <= m_var_CurrentRHS
                    Case OD_MC_Between
                        If IsArray(m_var_CurrentRHS) Then
                            m_var_BetMin = m_var_CurrentRHS(LBound(m_var_CurrentRHS))
                            m_var_BetMax = m_var_CurrentRHS(UBound(m_var_CurrentRHS))
                            m_boo_LastIsMatch = m_var_BetMin <= m_var_CurrentLHS And m_var_CurrentLHS <= m_var_BetMax
                        End If
                    Case OD_MC_Contains
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) <> 0
                    Case OD_MC_DoesNotContain
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) = 0
                    Case OD_MC_DoesNotEndWith
                        m_boo_LastIsMatch = InStrRev(m_var_CurrentLHS, m_var_CurrentRHS) <> Len(m_var_CurrentLHS) - (Len(m_var_CurrentRHS) - 1)
                    Case OD_MC_DoesNotStartWith
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) <> 1
                    Case OD_MC_EndsWith
                        m_boo_LastIsMatch = InStrRev(m_var_CurrentLHS, m_var_CurrentRHS) = Len(m_var_CurrentLHS) - (Len(m_var_CurrentRHS) - 1)
                    Case OD_MC_In
                        If IsArray(m_var_CurrentRHS) Then
                            For Each m_var_CurrentRHSElement In m_var_CurrentRHS
                                If m_var_CurrentRHSElement = m_var_CurrentLHS Then
                                    m_boo_LastIsMatch = True
                                    Exit For
                                End If
                            Next
                        End If
                    Case OD_MC_Like
                        m_boo_LastIsMatch = m_var_CurrentLHS Like m_var_CurrentRHS
                    Case OD_MC_NotBetween
                        If IsArray(m_var_CurrentRHS) Then
                            m_var_BetMin = m_var_CurrentRHS(LBound(m_var_CurrentRHS))
                            m_var_BetMax = m_var_CurrentRHS(UBound(m_var_CurrentRHS))
                            m_boo_LastIsMatch = m_var_CurrentLHS > m_var_BetMin Or m_var_BetMax < m_var_CurrentLHS
                        End If
                    Case OD_MC_NotEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS <> m_var_CurrentRHS
                    Case OD_MC_NotIn
                        If IsArray(m_var_CurrentRHS) Then
                            m_boo_LastIsMatch = True
                            For Each m_var_CurrentRHSElement In m_var_CurrentRHS
                                If m_var_CurrentRHSElement = m_var_CurrentLHS Then
                                    m_boo_LastIsMatch = False
                                    Exit For
                                End If
                            Next
                        End If
                    Case OD_MC_NotLike
                        m_boo_LastIsMatch = Not m_var_CurrentLHS Like m_var_CurrentRHS
                    Case OD_MC_StartsWith
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) = 1
                End Select
                If m_boo_LastIsMatch Then
                    m_int_CriteriaID = m_ina_PassJumps(m_int_CriteriaID)
                Else
                    m_int_CriteriaID = m_ina_FailJumps(m_int_CriteriaID)
                End If
            Wend
            If m_boo_LastIsMatch Then
                Select Case qOperation
                    Case OD_QO_Any
                        MatchInternal = True
                        Exit Function
                    Case OD_QO_Count
                        m_lng_MatchingLineCount = m_lng_MatchingLineCount + 1
                    Case OD_QO_Select
                        If m_lng_MatchingLineCount >= m_lng_MatchingLineDimension Then
                            m_lng_NewMatchLength = m_lng_MatchingLineDimension * 2
                            ReDim Preserve m_lna_MatchingLines(1 To m_lng_NewMatchLength)
                            m_lng_MatchingLineDimension = m_lng_NewMatchLength
                        End If
                        m_lng_MatchingLineCount = m_lng_MatchingLineCount + 1
                        m_lna_MatchingLines(m_lng_MatchingLineCount) = m_lng_LineIndex
                End Select
            End If
        Next
        Select Case qOperation
            Case OD_QO_Any
                MatchInternal = False
            Case OD_QO_Count
                MatchInternal = m_lng_MatchingLineCount
            Case OD_QO_Select
                If m_lng_MatchingLineCount > 0 Then
                    ReDim Preserve m_lna_MatchingLines(1 To m_lng_MatchingLineCount)
                    If lCount > 1 And m_lng_MatchingLineCount > 1 And m_int_OrderingCount > 0 Then
                        QuickPivotSort vraDataSource, m_lna_MatchingLines, 1, m_lng_MatchingLineCount
                    End If
                Else
                    Dim m_lna_DummyResult() As Long
                    m_lna_MatchingLines = m_lna_DummyResult
                End If
                lCount = m_lng_MatchingLineCount
                MatchInternal = m_lna_MatchingLines
        End Select
    Else
        Select Case qOperation
            Case OD_QO_Any
                MatchInternal = lCount > 0
            Case OD_QO_Count
                MatchInternal = lCount
            Case OD_QO_Select
                If lCount > 0 Then
                    ReDim m_lna_MatchingLines(1 To lCount)
                    For m_lng_LineIndex = 1 To lCount
                        m_lna_MatchingLines(m_lng_LineIndex) = m_lng_LineIndex
                    Next
                    If lCount > 1 And m_int_OrderingCount > 0 Then
                        QuickPivotSort vraDataSource, m_lna_MatchingLines, 1, lCount
                    End If
                Else
                    m_lna_MatchingLines = m_lna_DummyResult
                End If
                MatchInternal = m_lna_MatchingLines
        End Select
    End If
End Function

    您会注意到查询的尾部会根据“QueryOperation”（qOperation）而变化，如果您只是询问是否存在匹配项，它会提前退出，或者如果不需要跟踪匹配项，则只关注计数。

关注点

    我从这个过程中了解到，将运算符与操作数分开只会带来比应有的更大的麻烦。 这在基本层面上说明了短路从逻辑流程角度是如何工作的。  如果将其展开成一个完整的编译器，它可能会构建具体的指令跳转到失败点，如果存在满足条件的替代路线；但是，我认为这是另一天的话题了！

    完整的源代码包含在 TestBook.zip 的“Test Book.xlsm”中。

历史

2014 年 11 月 9 日 - 初次发布。

2014 年 11 月 9 日 - 添加了下载链接。  我以为它是自动的！

2014 年 11 月 12 日 - 更新了代码块的格式，显示为“VB.NET”，因为 CodeProject 解析存在问题。  它无法识别 VBScript 中的“Friend”关键字，而 VBA 并不是有效的语言选择。