Question

我有3张纸，在第一张纸上有一个“注册码”列，我在下一栏中提取了唯一的代码。请查看下图。

根据这些唯一代码，子代码分配在表2中。请检查下图。

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

我一直在使用各种公式组合，但无法得到正确的解决方案。在我开始在这个领域学习的时候，在VBA中做到这一点的最佳方法是什么。

Answer 1

根据一些条件，以下代码将执行您想要的操作。在您拥有数据的工作簿中将其安装在标准代码模块中（默认情况下为＆＃34; Module1＆＃34;，但您可以根据需要进行命名）。

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

以下是条件。

所有3张纸必须位于同一工作簿中。如果您将它们放在不同的工作簿中，则必须调整代码以处理多个工作簿。
必须存在两个包含数据的工作表。必须将它们命名为代码规定，或者必须修改代码以匹配它们的名称。输出工作表也是如此，但如果代码不存在，那么该代码将由代码创建。您可以在代码中更改其名称。
代码顶部的枚举假设所有3张纸的格式相同，第1行（标题）中的数据和A，B和C列中的数据都没有。变化并不困难但必须在你想要一个不同的输入或输出。您可以通过为枚举中的列指定其他值来更改现有代码中的列，但代码在所有工作表中都需要相同的排列。
不使用代码表中提取的代码。代码自己提取。如果无法提取代码或者在子代码列表中找不到代码，它将在输出列表中标记错误。
Numer表中的子代码必须按照您发布的图片进行排序。代码将查找第一次出现＆＃34; image＆＃34;并在代码为＆＃34; image＆＃34;时找到以下行中的子代码。在A列中。它不会发现＆＃34;图像＆＃34;中场休息后可能会跟进。
代码不做任何着色。添加它并不困难，但您必须指定一些规则，例如前20个代码的20种不同颜色，然后重复相同的序列＆＃34;。
可以毫不费力地添加其他单元格格式，因为每个单元格已经单独命名。可以轻松添加更多属性。

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

1 个答案: