Vba 在excel'中提取多个查找值；s-VLOOKUP公式

扩展我以前问过的一个问题，但现在我领先了一点，多亏了你们这些好朋友和其他来源的帮助

基本上，我可以从我的公司服务器中提取报告，它们以电子表格格式导出，其中每一行都是一份报告，每一列都是关于报告的信息（报告计数、生成日期、报告标题等），我关心的列有一个4位代码，标识报告来源的组（A205、A206、B208、Q404，有数千个）我们将此列称为“报告编号”

我目前正在使用VLOOKUP在参考表上查找代码，然后返回与代码关联的组的名称，因此如果代码为“A205”，公式将在单元格中返回“a-TEAM”。（我将其与一个宏配对，该宏一次对数百行执行此操作，并在下一个空列中填写名称）

现在，如果在“报告编号”列中只有一个代码，那么这非常有效。当一份报告由多个以逗号分隔的组完成时，我的问题就出现了。因此，在“报告编号”列中，可能有“A205、A206、B208”，我需要公式以相同的格式（即“A团队、B团队、C团队”）输出所有解码名称，而不是错误，或者只输出第一个

那么，有没有一种方法可以用VLOOKUP来实现这一点？如果函数不重复嵌套，或者我需要修改我的宏

这是我当前使用的宏（当我更改参数以匹配工作表名称等时），您可以看到输入vlookup公式的位置

Option Explicit
Sub CustomerCodeLookup()

Dim LastRow As Long
Dim LastColumn As Long
Dim RNColumn As Long
Dim RNFirstCell As String

'identify last row of data
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'get first blank column (by assuming first blank cell in row 1 is the first blank column)  
LastColumn = Cells(1, 1).End(xlToRight).Column + 1
'find the column that has "Report Number"
RNColumn = Range("1:1").Find("ReportNumber", LookIn:=xlValues).Column
'Relative address of first cell in Report Number column for use in the formula
RNFirstCell = Cells(2, RNColumn).Address(False, False)

'Add header to the lookup column
Cells(1, LastColumn) = "Group Name"
'insert formula from row 2 until the last data row
Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)) = "=VLOOKUP(LEFT(" & RNFirstCell & ", 5),'C:\Path\to\pulled workbook\[Codes.xlsm]Codereference'!$A:$O,2,0)"
'Remove formula from cells
Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)) = Range(Cells(2, LastColumn), Cells(LastRow, LastColumn)).Value

End Sub

---

你真的不想用VLOOKUP来解决这个问题。根据你使用的Excel版本，以下任何一种方法都是更好的方法

• 使用变量数组和使用数组将所有数据拉入VBA 操纵
• 使用变量数组和脚本字典将所有数据拉入VBA
• 如果您使用的是Excel 2016或更高版本，请使用PowerQuery将数据拉入Excel，并在PowerQuery界面中按照您的需要对其进行调整
• 如果您使用的是Excel 2013或更高版本，请将单独的表导入到数据模型中，并在公共字段中联接它们，以便您可以使用数据透视表来执行所描述的报告。（即使您安装的Excel SKU中没有PowerPivot外接程序，也可以执行此操作）

请注意，如果您运行的版本介于2010年和我上面提到的日期之间，那么PowerQuery和PowerPivot都可以作为免费加载项使用

---

PowerQuery和PowerPivot是迄今为止解决您的问题的最简单的方法，网络上有大量资源和YouTube上的视频可以帮助您入门。

因为您实际上不需要公式，请尝试使用jeffreyweir数组/字典建议：

Sub CustomerCodeLookup()

Dim P1 As Range, P2 As Range
Dim T2()
Set D1 = CreateObject("scripting.dictionary")
Set P1 = ActiveSheet.UsedRange
Set P2 = Workbooks("Codes.xlsm").Sheets("Codereference").UsedRange
T1 = P1
T3 = P2

For i = 1 To UBound(T3): D1(T3(i, 1)) = T3(i, 2): Next i
For i = 1 To UBound(T1, 2)
    If T1(1, i) Like "ReportNumber" Then RN = i
Next i

a = 1
For i = 2 To UBound(T1)
    ReDim Preserve T2(1 To a)
    St1 = Split(Trim(T1(i, RN)), ",")
    For j = 0 To UBound(St1)
        T2(a) = T2(a) & ", " & D1(St1(j))
    Next j
    T2(a) = Mid(T2(a), 3)
    a = a + 1
Next i

Range("A1").End(xlToRight).Offset(1, 1).Resize(a - 1) = Application.Transpose(T2)

End Sub

编辑：

Sub CustomerCodeLookup()

Dim P1 As Range, P2 As Range
Dim T2()
Set D1 = CreateObject("scripting.dictionary")
Set P1 = ActiveSheet.UsedRange
Set P2 = Workbooks("Codes.xlsm").Sheets("Codereference").UsedRange
T1 = P1
T3 = P2

'Line below feeds the dictionary as D1(Key)=Item where Key (T3(i, 1)) is first used column of Workbooks("Codes.xlsm").Sheets("Codereference") and Item (T3(i, 2)) second column
For i = 1 To UBound(T3): D1(T3(i, 1)) = T3(i, 2): Next i

For i = 1 To UBound(T1, 2)
    If T1(1, i) Like "ReportNumber" Then RN = i
Next i

a = 1
For i = 2 To UBound(T1)
    ReDim Preserve T2(1 To a)
    St1 = Split(Trim(T1(i, RN)), ",")
    For j = 0 To UBound(St1)
        T2(a) = T2(a) & ", " & D1(Left(Trim(St1(j)), 5))
    Next j
    T2(a) = Mid(T2(a), 3)
    a = a + 1
Next i

Range("A1").End(xlToRight).Offset(1, 1).Resize(a - 1) = Application.Transpose(T2)
Range("A1").End(xlToRight).Offset(0, 1) = "Group Name"

End Sub

---

非常感谢您的评论！我目前正在研究这些选项，我非常感谢您对这个问题的全新关注。非常感谢您。我相信它是有效的，但当我运行它时，我得到的只是空白单元格中的逗号。逗号的数量与代码的数量相对应，因此它读取正确，只是没有写入装饰把名字记下来。我肯定我遗漏了什么，你有没有可能添加一些注释？我对数组/字典方法不太熟悉。希望我遗漏了你的键实际上是报告编号的前5个字符，用

D1更新（左（Trim（St1（j）），5））

。还在末尾添加了列命名。哦！这不是前5个数字，而是前4个。就像上面的帖子一样，代码总是一个字母，后面跟着3个数字。我可能拼写错误，我更改了第5行：

D1（左（修剪（St1（j）），5））

对于a 4，我将您的标记为解决方案，因为它确实有效，而且非常漂亮！谢谢！现在只需清理它并在真实的工作表上运行，而不是在测试表上运行，再次感谢！这太神奇了！我还学到了很多关于一些可能会派上用场的新命令！再次感谢！在实际的报告上进行了测试Oracle很棒，代码非常实用，太好了！很有趣，它似乎在一个过滤过的工作表上工作（有时，RePosiNeTo列是空白的，所以我们只需要看到一个附加代码的报告，我们就可以过滤掉空白的列。）我注意到如果我先过滤数据，代码只会返回所有空格。但是如果我运行代码，然后过滤数据，它工作得很好。这不是什么大问题，但我看不出过滤应该如何影响它。