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

Question

我有3張紙，在第一張紙上，我有一列“注冊代碼”，並在下一列中提取了唯一的代碼。 請檢查下圖。

根據這些唯一的代碼，子代碼分配在工作表2中。請檢查下圖。

現在我在這里嘗試的是在工作表3中，我需要每個“注冊代碼”以及相關的“子代碼” ，這些代碼在工作表2中根據工作表1中給出的“唯一ID”進行分配。 請檢查以下圖片以獲得預期的輸出。

我一直在使用公式的各種組合，但是無法找到合適的解決方案。 在我剛剛開始學習VBA時，在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. Numer表中的子代碼必須按照您發布的圖片進行排序。 該代碼將查找第一次出現的“圖像”，並在隨后的行中找到子代碼，而該代碼在A列中為“圖像”。它將找不到中斷后可能出現的其他“圖像”出現。
6. 該代碼不做任何着色。 添加它並不困難，但是您必須指定一些規則，例如“前20個代碼使用20種不同的顏色，然后重復相同的順序”。
7. 可以輕松添加其他單元格格式，因為每個單元格已經單獨命名。 可以輕松添加更多屬性。