扩展了我之前提出的一个问题，但是现在有了您的好朋友和其他渠道的帮助，我走得更远。
基本上，我可以从公司服务器中提取报告，它们以电子表格格式导出，其中每一行都是报告，每一列都是有关该报告的信息（报告计数，制作日期，报告标题等），我关注的列有一个四位数的代码来标识报告来自的组（A205，A206，B208，Q404，有数千个）。将此列称为“报告编号”
我当前正在使用VLOOKUP在参考表上查找代码，然后返回与代码关联的组的名称，因此，如果代码为“ A205”，则公式将在单元格中返回“ A-TEAM” 。（我将其与一个宏配对，该宏一次可处理数百行，并在下一个空列中填写名称）
现在，这很好用...如果“报告编号”列中只有一个代码。当报告由逗号分隔的多个组完成时，就会出现我的问题。因此，在“报告编号”列中，它可能具有“ A205，A206，B208”，并且我需要公式以相同格式（即“ A团队，B团队，C团队”）输出所有已解码的名称，而不是出现错误，或者只是第一个。
那么，有没有办法用VLOOKUP做到这一点？不会一遍又一遍地嵌套IF函数。还是我需要修改宏？
这是我当前有效的宏（当我更改参数以使其与工作表名称匹配时），您可以看到在哪里输入了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
由于您实际上并不需要公式并尝试尝试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
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句