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

Question

我有一个包含两个不同工作表的Excel文档。表格1有许多列，其中包含标题名称和空白行。工作表2中的某些列具有确切的标题名称，并且在第二行中有一个条目。

我想创建一个宏，该宏将遍历工作表2中的所有列标题，并在工作表1中找到它们的对应匹配项。找到匹配项后，我需要将Sheet2标头的第2行中的条目复制到sheet1的匹配标头中。Sheet1中的某些条目将不匹配，并且将保留为空白。

当前我的2张纸：

Sheet1

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

Sheet2

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

运行宏后我想要什么：

Sheet1

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

我正在学习VBA，大约需要2周的时间。在使程序执行此操作时遇到了麻烦。我见过类似的问题，但它们通常只匹配一列中的一项，而不匹配多列中的多个名称。我尝试的代码未完成所需的操作。

此外，这必须作为宏或函数来完成，因为程序将被发送给需要自动完成的用户。我认为执行VLOOKUP在这里行不通，因为在用户输入它们之前，我不知道任何一个工作表中的列数，在这种情况下，程序将自动填充匹配行的第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

编辑：根据评论中的讨论，需要一种复制和粘贴方法。尽管我认为下拉列表仍然无法正常工作，但这仍将单元格保留为下拉列表。如果不希望这样，可以将xlPasteAll更改为其他格式，例如xlPasteValues。其他列出在Microsoft's documentation中。

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

Answer 2

我对VBA还是很陌生，我不太了解代码，但是，我复制并粘贴了您的第二个代码，它运行良好。但是，它只是填充第一行，而不是应该从工作表2填充的所有行。我认为下面的帖子是针对我要执行的操作的，但我不知道这是什么意思。你能帮忙吗？我真的会非常感激。

@@ 2by在我有偏移量的内部循环中，您可以捕获列的最后一行，并从开始行循环到最后一行。让我知道您是否需要帮助，但是有很多例子。 – PartyHatPanda19年6月18日在20:09