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

Question

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

基于这些唯一代码，子代码在片2分配请检查下面的图像。

现在我试图在这里的是，在表3，我需要每一个有关这是在Sheet2的基础上，“独一无二分配“子码”“注册代码” ID“在Sheet1中给出。请检查下面的图片预期的输出。

我一直在使用公式的不同组合，但不能得到妥善的解决方案。刚开始在这个领域学习时，在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. 包含数据的两个工作表必须存在。它们必须按照代码规定的名称命名，或者必须修改代码以匹配它们的名称。输出工作表也是如此，但如果该表不存在，该代码将由代码创建。您可以在代码中更改其名称。
3. 代码顶部的枚举假定所有3张纸的第1行（字幕）中没有数据，列A，B和C中的数据格式相同。更改并不困难，但必须在需要时进行一个不同的输入或输出。您可以通过将其他值分配给枚举中的列来更改现有代码中的列，但代码在所有表中需要相同的排列方式。
4. 代码表中提取的代码未使用。代码自己提取。如果无法提取代码或者在子代码列表中找不到代码，它将在输出列表中标记错误。
5. 数字表中的子代码必须按照您发布的图片进行排序。该代码将查找第一次出现的“图像”，并在代码为A列中的“图像”时查找以下行中的子代码。在中断之后，不会再发生可能出现的“图像”。
6. 该代码不会做任何着色。添加它并不困难，但您必须指定一些规则，例如“对于前20个代码使用20种不同的颜色，然后重复相同的顺序”。
7. 可以毫不费力地添加其他单元格格式，因为每个单元格都已单独命名。更多的属性可以轻松添加。