Vba 在两个工作表中查找多个匹配项，并在另一个工作表中复制粘贴

我需要一个宏，用于不同工作表中的多个匹配项，该宏将返回唯一id的所有值

表1包含唯一的ID和值，可能存在重复的值

在另一张表上，也可能有重复的值，并将为每个重复值指定相应的值

作为输出，我需要一个唯一id的所有对应值

第1页内容

id1 isin1
id2 isin1
id3 isin2
id4 isin3

第2页内容：

isin1 value1 age1
isin1 value2 age2
isin2 value3 age3
isin3 value4 age4
isin3 value5 age5
isin1 value6 age6
isin3 value7 age7


<U>Output</U>



id1 isin1 value1 age1
id1 isin1 value2 age2
id1 isin1 value6 age6

id2 isin1 value1 age1
id2 isin1 value2 age2
id2 isin1 value6 age6

id3 isin2 value3 age3

id4 isin3 value4 age4
id4 isin3 value5 age5
id4 isin3 value7 age7 

---

如果我没弄错的话，第一张纸上只有一个id？如果是这种情况，请在sheet1行中循环并读取每一行（id#，isin#）

然后，对于每个isin，您在sheet2中搜索isin，并获得另一对（值、年龄）。您现在有一组4个要输出。当然，你必须阅读所有isin的sheet2，所以把它放在一个循环中。作为一个简单的例子-（编辑-现在我有Excel要调试，代码比我的原始版本多一点）：

我希望变量命名约定很清楚，您没有确切指定工作表、行、列等的位置。另外，如果您感兴趣，请查找Range.FindNext方法。帮助文件包含一个循环，可以去掉第二个for循环。如果您没有太多的数据，这无关紧要（但这是更好的做法），但如果您有一个很长的值列表，则本机excel代码（如Range.FindNext）将运行一个数量级，甚至比手动编写检查每个单元格的for循环更快

---

如果我误解了你的问题，请让我知道，我会努力得到正确的答案（尽管我有工作！）。再说一次，我不会这样编码。有更优雅、更稳健、更高效的方法来完成这项工作，但我想先从一个可行的解决方案开始。

如果你能编辑这篇文章，让它包括错误的性质，也许还有你自己关于为什么它可能被破坏的一些理论…@Doug it之所以被破坏，是因为它不是一种方法。但我不确定这是不是很容易使用SELECT and JOIN访问…@HugoLemos谢谢。在Excel中不可能？是可能的，但这样的任务更容易访问。感谢您的努力。我对编程和VBA都是新手。我对其他功能了解不多。可以帮助编写函数代码。
在执行程序时，出现运行时错误92。确定。是否存在与运行时错误92关联的消息？我能看看你输入的密码吗？我的现在是一种伪代码。它不是一个完整的子程序。例如，您需要将val（1到4）调暗为int、long或double（取决于您正在读取的数据）。请参阅更新的代码。对不起，昨晚我写了这个，因为我没有带Excel。你的错误可能是因为我在发布的原始代码中命名了数组val（1到4）。Val是一个函数，因此存在类型不匹配或其他问题。现在是dataVal（1到4）。它工作了吗？如果还有其他错误，请告诉我。这对我有用。

Option Explicit

Sub test()

Dim varSheetA As Variant
Dim varSheetB As Variant
Dim varSheetC As Variant
Dim strRangeToCheck1 As String
Dim strRangeToCheck2 As String
Dim strRangeToCheck3 As String   

Dim iRow1 As Long
Dim iCol1 As Long
Dim iRow2 As Long
Dim iCol2 As Long
Dim iRow3 As Long
Dim iCol3 As Long

strRangeToCheck1 = "A1:B5"
strRangeToCheck2 = "D1:E6"
strRangeToCheck3 = "f1:h22"

Debug.Print Now

varSheetA = Worksheets("Sheet1").Range(strRangeToCheck1)
varSheetB = Worksheets("Sheet1").Range(strRangeToCheck2)
varSheetC = Worksheets("Sheet1").Range(strRangeToCheck3)

Debug.Print Now

For iRow1 = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol1 = LBound(varSheetA, 2) To UBound(varSheetA, 2)

For iRow2 = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol2 = LBound(varSheetA, 2) To UBound(varSheetA, 2)

If varSheetA(iRow1, 2) = varSheetB(iRow2, 1) Then

    varSheetC(iRow1, 1).Value = varSheetA(iRow1, 1).Value " Here i am  getting 424 runtime error"

Else
End If

Next iCol2
Next iRow2

Next iCol1
Next iRow1

End Sub 

Option Explicit

Sub Tester()

Dim counter1 As Long
Dim counter2 As Long
Dim counter3 As Long
Dim counter4 As Long

Dim firstSheet1Row As Long
Dim lastSheet1Row As Long
Dim firstSheet2Row As Long
Dim lastSheet2Row As Long

Dim firstColNumSht1 As Long
Dim secondColNumSht1 As Long
Dim firstColNumSht2 As Long
Dim secondColNumSht2 As Long
Dim thirdColNumSht2 As Long

Dim writeRow As Long

Dim dataVal(1 To 4) As Long

firstSheet1Row = 1
lastSheet1Row = 10
firstSheet2Row = 1
lastSheet2Row = 20

firstColNumSht1 = 1
secondColNumSht1 = 2
firstColNumSht2 = 1
secondColNumSht2 = 2
thirdColNumSht2 = 3

writeRow = 1

For counter1 = firstSheet1Row To lastSheet1Row

  dataVal(1) = Worksheets(1).Cells(counter1, firstColNumSht1)
  dataVal(2) = Worksheets(1).Cells(counter1, secondColNumSht1)

    For counter2 = firstSheet2Row To lastSheet2Row

      If Worksheets(2).Cells(counter2, firstColNumSht2) = dataVal(2) Then

        dataVal(3) = Worksheets(2).Cells(counter2, secondColNumSht2)
        dataVal(4) = Worksheets(2).Cells(counter2, thirdColNumSht2)

        For counter3 = 1 To 4
          Worksheets(3).Cells(writeRow, counter3) = dataVal(counter3)
        Next counter3

        writeRow = writeRow + 1

      End If

    Next counter2

  Next counter1


End Sub