如何在VBA中使用一个vlookup获取多个结果，其中vlookup是整个string的一部分（vlookup值）

我有3张，在表一中我有一个“注册码”栏，我已经提取了下一列的唯一代码。 请检查下面的图片。

基于这些独特的代码，在表2中分配了子代码。请检查下面的图像。

现在我在这里尝试的是，在表3中，我需要根据Sheet1中给出的“唯一ID”在sheet2中分配相关的“子代码”的每个“注册代码” 。 请检查下面的图片预期的输出。

我一直在使用公式的各种组合，但无法得到一个适当的解决scheme。 在刚开始学习这个领域时，在VBA中做什么是最好的方法。

Answer 1

根据一些条件，下面的代码将做你想要的。 将它安装在一个标准的代码模块中（默认情况下为“Module1”，但您可以随意命名）放在您有数据的工作簿中。

Option Explicit Enum Nws ' Worksheet navigation NwsFirstDataRow = 2 ' presumed the same for all worksheets NwsCode = 1 ' 1 = column A (change as required) NwsSubCode ' No value means previous + 1 NwsNumer End Enum Sub NumerList() ' 05 Apr 2017 Dim Wb As Workbook ' all sheets are in the same workbook Dim WsCodes As Worksheet ' Register codes Dim WsNum As Worksheet ' Sub-code values Dim WsOut As Worksheet ' Output worksheet Dim RegName As String, RegCode As String Dim Sp() As String Dim Rs As Long ' Source row in WsNum Dim Rt As Long ' Target row in WsOut Dim R As Long, Rl As Long ' rows / Last row in WsCodes Set Wb = ActiveWorkbook ' Make sure it is active! Set WsCodes = Wb.Worksheets("Reg Codes") ' Change name to your liking Set WsNum = Wb.Worksheets("Code Values") ' Change name to your liking On Error Resume Next Set WsOut = Wb.Worksheets("Output") ' Change name to your liking If Err Then Set WsOut = Wb.Worksheets.Add(After:=WsNum) WsOut.Name = "Output" ' create the worksheet if it doesn't exist End If On Error GoTo 0 Rt = NwsFirstDataRow With WsCodes Rl = .Cells(.Rows.Count, NwsCode).End(xlUp).Row For R = NwsFirstDataRow To Rl RegName = .Cells(R, NwsCode).Value Sp = Split(RegName, "-") If UBound(Sp) > 1 Then ' must find at least 2 dashes RegCode = Trim(Sp(1)) Else RegCode = "" End If If Len(RegCode) Then On Error Resume Next Rs = WorksheetFunction.Match(RegCode, WsNum.Columns(NwsCode), 0) If Err Then Rs = 0 On Error GoTo 0 If Rs Then Do WsOut.Cells(Rt, NwsCode).Value = RegName WsOut.Cells(Rt, NwsSubCode).Value = WsNum.Cells(Rs, NwsSubCode).Value WsOut.Cells(Rt, NwsNumer).Value = WsNum.Cells(Rs, NwsNumer).Value Rt = Rt + 1 Rs = Rs + 1 Loop While WsNum.Cells(Rs, NwsCode).Value = RegCode Else RegCode = "" End If End If If Len(RegCode) = 0 Then WsOut.Cells(Rt, NwsCode).Value = RegName WsOut.Cells(Rt, NwsSubCode).Value = "No sub-code found" Rt = Rt + 1 End If Next R End With End Sub 

这里是条件。

1. 所有3张表必须在同一个工作簿中。 如果他们在不同的工作簿中，则必须修改代码以处理多个工作簿。
2. 包含数据的两个工作表必须存在。 它们必须按照代码规定的名称进行命名，或者必须修改代码以匹配它们的名称。 输出工作表也是如此，但如果不存在，该表将由代码创build。 您可以在代码中更改其名称。
3. 代码顶部的枚举假设所有3张表格的第1行（字幕）中没有数据，列A，B和C中的数据的格式相同。更改并不困难，但是如果您需要不同的input或输出。 您可以通过将其他值分配给枚举中的列来更改现有代码中的列，但代码在所有工作表中需要相同的排列方式。
4. 代码表中提取的代码不被使用。 代码自己提取。 如果无法提取代码或在子代码列表中找不到代码，则会在输出列表中标记错误。
5. 数字表中的子代码必须按照您发布的图片进行sorting。 代码将查找“image”的第一个匹配项，并在代码为“image”的列A中查找以下行中的子代码。在中断之后，不会再find可能出现的“image”。
6. 该代码不会做任何着色。 添加它并不困难，但是您必须指定一些规则，例如“对于前20个代码使用20种不同的颜色，然后重复相同的顺序”。
7. 其他单元格格式化可以毫不费力地添加，因为每个单元格已经被单独命名。 更多的属性可以很容易地添加。