如何在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. 可以毫不費力地添加其他單元格格式，因爲每個單元格都已單獨命名。更多的屬性可以輕鬆添加。