如何在不同的工作表中匹配标题，如果匹配则复制/粘贴第二行？

我有两个不同的表格的Excel文档。 工作表1有许多列标题名称和空行。 工作表2有一些具有精确标题名称的列和第二行中的条目。

我想要制作一个macros来查看Sheet 2中的所有列标题，并在Sheet1中查找它们的相应匹配项。 当find匹配项时，我需要将Sheet2标题的第2行中的条目复制到sheet1的匹配标题中。 Sheet1中的某些条目将不会有匹配，并保持空白。

我目前2张：

工作表Sheet1

apple | orange | mango | grape | banana ------------------------------------------ [BLANK] |[BLANK] |[BLANK] |[BLANK] | [BLANK] 

Sheet2中

 orange | mango | banana -------------------------- yumm | yuck | maybe 

macros运行后我想要什么：

工作表Sheet1

 apple | orange | mango | grape | banana ------------------------------------------ [BLANK] |yumm |yuck |[BLANK] | maybe 

我正在学习VBA，大约两个星期。我有麻烦让我的程序做到这一点。 我看过类似的问题，但是他们通常只匹配一列中的一个项目，而不是多列中的多个名称。 我试过的代码没有做任何我需要的东西。

此外，这必须作为一个macros或函数完成，因为程序将被发送到需要这个已经自动完成的用户。 我认为做VLOOKUP在这里是行不通的，因为直到用户input它们，我都不知道任何一个表中的列数，在这种情况下，程序会自动填充匹配行的第2行。 有任何想法吗？

Answer 1

这将做到这一点，假设图纸名称是Sheet1和Sheet2 。

 Sub colLookup() Dim ShtOne As Worksheet, ShtTwo As Worksheet Dim shtOneHead As range, shtTwoHead As range Dim headerOne As range, headerTwo As range Set ShtOne = Sheets("Sheet1") Set ShtTwo = Sheets("Sheet2") Dim lastCol As Long 'get all of the headers in the first sheet, assuming in row 1 lastCol = ShtOne.Cells(1, Columns.count).End(xlToLeft).column Set shtOneHead = ShtOne.range("A1", ShtOne.Cells(1, lastCol)) 'get all of the headers in second sheet, assuming in row 1 lastCol = ShtTwo.Cells(1, Columns.count).End(xlToLeft).column Set shtTwoHead = ShtTwo.range("A1", ShtTwo.Cells(1, lastCol)) 'actually loop through and find values For Each headerTwo In shtTwoHead For Each headerOne In shtOneHead If headerTwo.Value = headerOne.Value Then headerOne.Offset(1, 0).Value = headerTwo.Offset(1, 0).Value End If Next headerOne Next headerTwo End Sub 

编辑：根据评论中的讨论，复制和粘贴方法是需要的。 这使得单元格保持列表下拉状态，尽pipe我不认为下拉菜单仍然有效。 如果不需要，可以将xlPasteAll更改为其他格式，例如xlPasteValues 。 其他人在微软的文档中列出。

 Sub colLookup() Dim ShtOne As Worksheet, ShtTwo As Worksheet Dim shtOneHead As range, shtTwoHead As range Dim headerOne As range, headerTwo As range Set ShtOne = Sheets("Sheet1") Set ShtTwo = Sheets("Sheet2") Dim lastCol As Long 'get all of the headers in the first sheet, assuming in row 1 lastCol = ShtOne.Cells(1, Columns.count).End(xlToLeft).column Set shtOneHead = ShtOne.range("A1", ShtOne.Cells(1, lastCol)) 'get all of the headers in second sheet, assuming in row 1 lastCol = ShtTwo.Cells(1, Columns.count).End(xlToLeft).column Set shtTwoHead = ShtTwo.range("A1", ShtTwo.Cells(1, lastCol)) 'actually loop through and find values For Each headerTwo In shtTwoHead For Each headerOne In shtOneHead If headerTwo.Value = headerOne.Value Then headerTwo.Offset(1, 0).Copy headerOne.Offset(1, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False End If Next headerOne Next headerTwo End Sub