A) VBA “VLookup” 基于 ListObject 数据
当您在 OP 中提到 ListObject 时，我专注于一种基于完全 listobject 数据 的方法。
作为一个实际的盈余，通过现有的表标题或索引号来识别列引用将是简洁。因此，下面的函数 multCrit() 会返回具有任意数量的列条件的给定列 (retCol) 的值。
“作为一种幻想，我正在寻找类似 @987654326@ 的东西，
小而善解人意。”
在ParamArray 中组织输入可能至少有助于保持函数调用 small 和 clear，例如通过以下伪语法
multCrit(lo, ReturnColumn, ParamArray:{Col1, search1, Col2, search2,...})
请注意，我只颠倒了 ParamArray 中的输入顺序。
需要的参数
- 第一个参数
data 标识一个ListObject，
- 第二个参数
retCol 标识要返回的列（标题或索引），
- 第三个基于 0 的参数
ParamArray arr() 允许按以下顺序进行多个输入：
- even inputs identify column (by header string or index number)
- odd inputs define a search value (e.g. explicitly or as cell reference)
“我猜应该有一个内置的方法在 VBA 中执行此操作。”
这种方法有条不紊地尝试
- 为每个条件获取列数组块（一次性通过
Application.Index() -注意 两个 数组参数的使用!)
- 在临时数组容器
tmp（又名锯齿状数组）内，并且
- 在每个标准块中显示结果值
1（对于未发现结果显示 #NV 错误 2042）。
这允许在所有指示的列blocks中识别值1序列，即使这种方法不处理内置检查，如 Excel 函数中的布尔值相乘。 - 当然还有一些改进的机会（例如找到下一个可能的项目而不是逐行循环），但它说明了方法。
函数multCrit()
Function multCrit(data As ListObject, ByVal retCol, ParamArray crit() As Variant) As Variant
'0) provide for 0-based temporary array container (aka jagged critay)
Dim critCnt As Long: critCnt = (UBound(crit) + 1) \ 2
Dim tmp: ReDim tmp(0 To critCnt - 1)
'1) include an array/column in one go into temporary array container
Dim c As Long
For c = LBound(crit) To UBound(crit) Step 2
'~~~~~~~~~~~~~~~~~~~
'execute 1 Match/col ~~> found elements receive value 1 (non-findings error 2042)
'~~~~~~~~~~~~~~~~~~~
tmp(c \ 2) = Application.Match(getCol(data, crit(c)), Array(crit(c + 1)), 0)
'Debug.Print "tmp(" & c \ 2 & ")", "header: " & crit(c), data.ListColumns(crit(c)).Index, crit(c + 1)
Next
'2) get lookup value as soon as all column values in a given row equal 1
Dim r As Long
For r = 1 To UBound(tmp(0))
For c = 0 To UBound(tmp)
'check next row, if no value 1 found
If IsError(tmp(c)(r, 1)) Then Exit For ' escape to check next row
If c = UBound(tmp) Then ' struggled through to last element
'get result value of found row from referenced retCol
multCrit = getCol(data, retCol)(r, 1): Exit Function
End If
Next c
Next r
End Function
帮助功能getCol()
返回由 ListObject 的 header name 或 index number 标识的列数据：
Function getCol(data As ListObject, header)
'Purp: get listobject column data via header (either string or index number)
getCol = data.DataBodyRange.Columns(data.ListColumns(header).Index)
End Function
调用示例
请注意，该函数允许标题（和搜索项）输入的任何顺序，无论是显式还是作为范围引用；所以这个例子也演示了一个修改的列顺序和范围输入：
Sub ExampleCall()
Dim lo As ListObject
Set lo = Sheet1.ListObjects("Table1")
'example display in VB Editor's immediate window: ~~> EN
Debug.Print "*~~>", multCrit(lo, "lang", "Col2", "two", "Col3", "three", "Col1", Sheet1.Range("B1"))
End Sub
可能的代码扩展 // 编辑于 2021-12-12
如果您不坚持返回一个值 （对于VLookUp 解决方案很典型），而是返回找到的数据 row 作为进一步的选择，您可以
- 提供例如用于将零输入 (
0) 传递给参数 retCol 和
- 将函数
MultCrit()的最后一段代码修改如下：
'get result value of found row from referenced retCol
If retCol = 0 Then ' special arg 0: return row
multCrit = r
Else ' default: return value
multCrit = getCol(data, retCol)(r, 1): Exit Function
End If
然后通过Debug.Print "*~~>", multCrit(lo, 0, "Col2", "two", "Col3", "three", "Col1", Sheet1.Range("B1")) 显示将显示例如第二行作为数字结果：~~> 2。
B) 通过.Value(12)中的 XlRangeValueDataType 枚举的简短替代方法 // ►late Edit as of 2021-12-13◄
这种有条不紊的新方法完全基于.Value(xlRangeValueMSPersistXML)（也称为.Value(12)）的字符串分析，它返回指定（ListObject ) 范围为 XML 格式 字符串。
- 一个 sn-p 示例，其中包含列信息属性
Col1、Col2 等的行节点可以是：
<xml><!-- omitting all namespace definitions -->
<!-- omitted ... -->
<rs:data>
<z:row Col1="DE" Col2="eins" Col3="zwei" Col4="drei"/>
<!-- etc... -->
</rs:data>
</x:PivotCache>
</xml>
通过 XPath 搜索表达式将所有以编程方式设置标准条件，例如此处，例如
"//zrow[@Col3='two' and @Col4='three' and @Col2='one']/@Col1"`
允许返回由参数retCol 传递的索引列值。 *（请注意，我对原始内容进行了转换，以便在没有命名空间问题的情况下进行更轻松的搜索，参见 zrow 而不是 z:row）
在情况 A 的情况下，可以类似于 ExampleCall 调用此示例（但不会返回 “可能的代码扩展”中建议的行索引）。
Function MultCrit12(lo As ListObject, ByVal retCol, ParamArray crit() As Variant) As Variant
'1) get FilterXML arguments
' a) Arg1: wellformed xml content string (xlRangeValueMSPersistXML = 12)
Dim content As String
content = Replace(lo.Range.Value(12), ":", "")
' b) Arg2: XPath by analyzing ParamArray crit()
Dim c As Long
Dim XPath As String: XPath = "//zrow["
For c = LBound(crit) To UBound(crit) Step 2
XPath = XPath & " and @Col" & lo.ListColumns(crit(c)).Index & "='" & crit(c + 1) & "'"
Next
If VarType(retCol) = vbString Then retCol = lo.ListColumns(retCol).Index ' get column index of header
XPath = Replace(XPath, "[ and ", "[") & "]/@Col" & retCol
'2) apply FilterXML upon above arguments
With Application
Dim ret
ret = .FilterXML(content, XPath) ' << FilterXML
If VarType(ret) > vbArray Then
MultCrit12 = ret(1, 1)
Else
MultCrit12 = ret
End If
End With
End Function