Vba 从数据库中查找一个值，并将匹配值列表获取到另一个工作表

我想从列表中找到相应的光盘代码，并将其复制到汇总表的DiscName列中。一些实验室名称将有多个光盘代码，因此当我运行宏时，它应将与实验室名称匹配的所有相关光盘代码调到DiscName列。任何帮助都将不胜感激。 不确定我是否可以上传汇总表的图像，但我看起来像这样

Col 1                col 2     col 3
Lab name             Disc Name
(say abcd)           xxxx
                     yyyy
                     zzzz
                     pppp

Col 1          Col 2
Lab name       Disc name
abcd            xxxxx
abcd            yyyyy
abcd            zzzzz
abcd            ppppp
bcda            qqqqq
bcda            rrrrr
bcda            iiiii
bcda            jjjjj
bcda            kkkkk   

这个列表看起来像这样

Col 1                col 2     col 3
Lab name             Disc Name
(say abcd)           xxxx
                     yyyy
                     zzzz
                     pppp

Col 1          Col 2
Lab name       Disc name
abcd            xxxxx
abcd            yyyyy
abcd            zzzzz
abcd            ppppp
bcda            qqqqq
bcda            rrrrr
bcda            iiiii
bcda            jjjjj
bcda            kkkkk   

我只是重新安排了桌子，这样看起来更清楚。希望这有助于更好地理解我的疑问。 再次感谢您的帮助

我尝试了这段代码，但我无法让它在摘要表中的Disc name下的下一行中写入下一个Disc name。它重复与第一个相同的光盘名称。理想情况下，它应该继续在汇总表中填写所有相关的光盘名称，并在列表中显示实验室名称

子Vlooker（）

作为字符串的暗FindString 变暗Rng As范围 暗fcomp 表中各fcomp（“续”）范围（“p3”）源比较范围

FindString = fcomp


    With Sheets("list").Range("q2:q106") 'range of cells to search
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(1), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False)

        If Rng Is Nothing Then



        Else
        Do While fcomp = FindString
          fcomp.Offset(0, 1).Value = Rng.Offset(0, 1)
          fcomp.Offset(1, 1).Value = Rng.Offset(0, 1) 
          Loop

        End If
    End With

下一个fcomp

端接头

这就是我想要发生的事情，真的

Go to List, Check A2. 
If list A2 matches with Summary A2 then 
go to summary b2
make summary b2 value = to list b2 value
then chekc next row in list
if found match with summary a2 then
go to summary, last actioned cell, go one row down and make value = to the value in column b in  list against the matching cell
Repeat this process till all matches found for summary a2.
Start this process when ever value of summay a2 changes.

---

此函数将执行与您要求的类似的操作。将代码放置在VBA编辑器的新模块中

确保第二个选项卡名为“映射”（或更改代码）。此选项卡应有两列，正如您在问题中所确定的那样

然后只需将单元格B2设置为公式=规则查找（B1），您就会看到查找到的数据。请注意，您还必须编辑B列的格式，以便在“对齐”选项卡上“换行文字”

我不认为这正是你想要的，但它可能会解决你的问题。如果这不起作用，您可能需要研究使用宏创建一个新选项卡，该宏在运行时清除该选项卡并输出报告

请注意，如果更新基础数据，即使启用了自动计算，也可能需要按CTRL+ALT+F9强制重新计算所有内容

Function DisciplineLookup(TheLabName As String) As String

    Dim objSheet As Worksheet, intUsedRows As Integer
    Set objSheet = Sheets("Mappings")
    intUsedRows = objSheet.UsedRange.Rows.Count

    'Get all of the relevant data into a VBA array.
    Dim objData() As Variant
    objData = objSheet.Range("A2", "B" & CStr(intUsedRows)).Value
    Dim objDisciplines As New Collection


    'Find rows matching the passed parameter, and add them to a collection
    Dim intI As Integer
    For intI = 1 To intUsedRows - 1
        If objData(intI, 1) = TheLabName Then
            objDisciplines.Add objData(intI, 2)
        End If
    Next

    'Format the collection into a new concatenated string
    'Note this may be really slow if you have a lot of data
    ' If so, look into using an array and the JOIN function
    Dim strDisciplines As String, strDiscipline As Variant
    strDisciplines = ""
    For Each strDiscipline In objDisciplines
        strDisciplines = strDisciplines & CStr(strDiscipline) & vbCrLf
    Next

    'trim trailing CRLF
    If Len(strDisciplines) > 0 Then
        strDisciplines = Left(strDisciplines, Len(strDisciplines) - 2)
    End If

    DisciplineLookup = strDisciplines

End Function

---

我怀疑您需要使用VLOOKUP（），但您的问题不清楚，因为格式没有通过。在每个示例行前面放四个空格，以便格式显示为代码，或者放一张工作表的屏幕截图。@NYCdotNet我刚刚按照你的建议编辑了我的文章。希望现在更清楚。。Thnks..如果需要考虑多个匹配项，最好使用range

。在循环中查找
方法。或者您可以使用列表页上的range
.AutoFilter
方法，然后迭代可见单元格（
SpecialCells（xlCellTypeVisible）
）？或者您可以在内存中构建一个数组，然后将其打印/转置到工作表中？有几种方法可以解决这个问题。到目前为止，你尝试了什么？@NYCdoNet谢谢，伙计，只有一个问题，有多个学科，它们都在一个细胞中，有没有办法将它们分开，以便将一个光盘安装到一个细胞中？我怀疑你可能想要这样。最好的方法是创建一个名为“report”的新选项卡，并编写一个宏来清除该选项卡，并在渲染每个实验室时，将前两个选项卡中的所有数据复制到嵌套FOR循环中，从而打破所有规程。上述函数是内部循环的良好起点，但是您将返回规程集合
objDisciplines
，而不是返回串联字符串。希望有帮助。