在另一个工作簿中的其他工作表中共有的工作表中查找ID

我有两个工作簿，其中包含两个不同的工作表中的公用项目ID。 我创build了一个代码，它允许程序在一张表中search唯一的ID，从该行中检索与该ID相关的信息，然后粘贴到相应项目ID的行中，再到另一个工作簿中的另一个工作表。 这个代码可以工作，但是只能在这两个列表完全相同的顺序下工作，事实上它们混杂在一起。 所以我需要帮助将查找function合并到代码中，该代码在一个工作簿工作表中查找项目ID，检索行信息并将其粘贴到另一个工作簿工作表。

Sub AAA() 'If Workbooks("Source.xlsm").Sheets("Sheet2").Range("A2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("A2").Value Then 'Workbooks("Source.xlsm").Sheets("Sheet2").Range("B2").Value = Workbooks("Target.xlsm").Sheets("Sheet1").Range("C2").Value Dim a As Long Dim lastrow As Long Dim lastcol As Long Dim source As Worksheet Dim target As Worksheet Dim cellFound As Range Set target = Workbooks("Target.xlsm").Sheets("Sheet1") Set source = Workbooks("Source.xlsm").Sheets("Sheet2") lastrow = source.Range("A" & target.Rows.Count).End(xlUp).Row lastcol = target.Cells(2, target.Columns.Count).Column target.Activate 'For a = 2 To 50 For Each cell In target.Range("A2:A500") ' Try to find this value in the source sheet Set cellFound = source.Range("A:A").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not cellFound Is Nothing Then cell.Offset(ColumnOffset:=2).Copy cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues 'If source.Range("A" & a).Value = target.Range("A" & a).Value Then 'target.Range("C" & a).Select 'Range(ActiveCell, ActiveCell.Offset(0)).Copy 'source.Range("B" & a).PasteSpecial Else Exit Sub End If Next End Sub 

Answer 1

像下面的东西应该匹配他们，不pipeID是什么顺序，你必须使用两个数组。 假设ID在列A中，它复制B列，请继续添加你希望复制的许多列。 请参阅下面的内容并尝试使用自己的代码 UNTESTED。

 Dim fpath As String Dim owb As Workbook fpath = "change to the location of workbook you want to paste to" Set owb = Application.Workbooks.Open(fpath) 'opens workbook Dim Master As Worksheet 'your current book Dim Slave As Worksheet 'one your pasting too 'please verify if the master and slave are correct here Set Slave = owb.Worksheets("name of sheet in one your pasting too") Set Master = ThisWorkbook.Worksheets("name of sheet in book you are in") For i = 1 To 1000 '(the slave sheet) For j = 1 To 1000 '(the master sheet) If Master.Cells(j, 1).Value = "" Then ExitFor If Master.Cells(j, 1).Value = Slave.Cells(i, 1).Value Then 'assuming both Id's are in column A Slave.Cells(i, 2).Value = Master.Cells(j, 2).Value 'this will copy column B, continue to add for each column you want copying eg add another with "3" and "4" etc. End If End If Next Next MsgBox ("Data Transfer Successful")