比较并匹配 2 列并将匹配项的值从工作簿 1 中的下一列复制到工作簿 2 中的空列与匹配项

Question

我是 VBA Excel 新手。

注意：

我已经为 2 个单独的工作表编写了这个程序，但我最初有 2 个单独的工作簿，我希望为 2 个单独的工作簿编写代码。

问题：

在 工作簿 1，工作表名称 (AM_quote-overview_sales-inputs) 我有 2 列。 A 列包含主题信息，B 列中包含与该信息相关的数据。

在 Workbook 2 中，我有 A 列 包含主题信息单词，其中一些类似于我在 AM_quote-overview_sales-inputs 表中的内容，而有些则不是，并且在列中B. 我需要在匹配时从工作簿 1 表 (AM_quote-overview_sales-inputs) 的 B 列复制值。

我想要 Workbook 2 (Sheet 1) 中的宏，它将 A 列中的主题信息的值与 Workbook 1 Sheet (AM_quote-overview_sales-inputs) 中 A 列中的主题信息的值进行比较然后将工作簿 1 工作表 (AM_quote-overview_sales-inputs) 的 B 列中的值复制到工作簿 2 (工作表 1) 的 B 列。

我的书面代码比较了单词，但是当我在工作簿 2 的工作表 1 中添加新行时，从工作簿 1 的 B 列复制到工作簿 2 的 B 列的值不准确。

我需要比较 2 列并将工作簿 1 工作表 (AM_quote-overview_sales-inputs) 的 B 列的值复制到工作簿 2 (Sheet1) 的 B 列，以获取两个工作表的 A 列中比较或匹配的单词。

查看下图了解详细信息。

代码：

Private Sub CommandButton1_Click()

Dim oldRow As Integer

Dim newRow As Integer

Dim i As Integer

i = 1

For oldRow = 1 To 1170

    For newRow = 1 To 1170

       If StrComp((Worksheets("AM_quote-overview_sales-inputs").Cells(oldRow, 1).Text), (Worksheets("Sheet1").Cells(newRow, 1).Text), vbTextCompare) <> 0 Then
            i = oldRow
            Worksheets("Sheet1").Cells(i, 2) = " "
            Else
          Worksheets("Sheet1").Cells(i, 2) = Worksheets("AM_quote-overview_sales-inputs").Cells(newRow, 2)
            i = i + 1
            Exit For
        End If
    Next newRow
Next oldRow

End Sub

1 WorkBook 1 Sheet (AM_quote-overview_sales-inputs) 数据

2 工作簿 2（表 1）数据

例子：

    Workbook 1          Sheet AQR Data      WorkBook 2         Sheet 1 
    Col A                  Col B            Col A               Col B
    Ford                   3                BMW                                                                         
    BMW                    4                Ford                                                        
    Jaguar                 5                Rolls Royce                                                       
    Rolls Royce            6                Jaguar                                                       

我在工作簿中有 2 列。

我需要一个工作簿 2 Sheet 1 中的宏，它将从 A 列 中提取诸如 BMW 等值，并匹配 A 列中存在的这些值Workbook 1 Sheet AQR 和与之匹配的单词将 Workbook 1 的 B 列 中的 3、4 等单词的值复制到 Workbook 2 的 B 列在Words前面。

在 BMW 前面，我需要像 4 这样的值，所以在匹配单词后，我需要在 Workbook 2 的 Col B 中使用 4。

Answer 1

请看下面一行：

Worksheets("Sheet1").Cells(i, 2) = Worksheets("AM_quote-overview_sales-inputs").Cells(newRow, 2)

newRow 变量分配给输出，而不是输入循环 - 你应该用oldRow 替换它，然后它应该可以正常工作。 您还应该颠倒循环使用的顺序 - 您应该使用以下逻辑（请参阅我的解决方案 1 示例）：

For newRow = 1 To 1170
    For oldRow = 1 To 1170
       ...
    Next oldRow
Next newRow

如果您找到特定值的结果，它可能会在下一个循环中替换为“”。

我还有3个不影响结果但可能影响效率的备注：

1. 您也可以跳过i 变量，因为您可以通过循环中使用的变量来管理所有内容。

2. 您不必每次都将输出单元格放入“” - 使用相反的循环顺序，您可以在内部循环之前执行此操作（我将在下面的示例中显示）。

3. 您可以搜索它，而不是将 fix max row 放入循环中 - 请参阅下面的示例，其中我确定了 lrow_Input 和 lrow_Output 的值，而不是使用 '1170'。

请看下面两个从一个工作簿匹配到另一个工作簿的解决方案示例： 两种解决方案的假设：

1. WB_Input.xlsb 是您拥有 'AM_quote-overview_sales-inputs' 工作表的文件，并且您想要匹配来自此 WB 的值（结构与您的示例相同 - 要使用 col A 和 col B）

2. WB_Output.xlsb 是您希望在 col B 中为 col A 中的值生成结果的文件：

3. 我不知道你想把你的代码放在哪里（在输入或输出文件中，这就是为什么我把文件的确切名称放在 - 一旦你决定你可以替换行分配工作簿到对象（例如 Set WB_Input = Workbooks("WB_Input.xlsb") ) 将其分配给ThisWorkbook。

解决方案 1 是您调整后的代码：

Sub solution1()

Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_input As Integer, lrow_output As Integer 'variables indicating last fulfilled rows
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet


Set WB_Input = Workbooks("WB_Input.xlsb")
Set WB_Output = Workbooks("WB_Output.xlsb")

Set WS_Input = WB_Input.Worksheets("AM_quote-overview_sales-inputs")
Set WS_Output = WB_Output.Worksheets("Sheet1")

With WS_Input
    lrow_input = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

With WS_Output
    lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

For newRow = 1 To lrow_output

WS_Output.Cells(newRow, 2).Value = "" 'you clear cell only once, not during each search

    For oldRow = 1 To lrow_input
        If (StrComp((WS_Input.Cells(oldRow, 1).Value2), (WS_Output.Cells(newRow, 1).Value2), vbTextCompare) = 0) Then
           WS_Output.Cells(newRow, 2).Value = WS_Input.Cells(oldRow, 2).Value
           Exit For
        End If

    Next oldRow
Next newRow

End Sub

解决方案 2 使用 Excel 公式 VLOOKUP 和 IFERROR，代码将公式放入第一个单元格并将其复制到下面的所有单元格（直到最后需要的行）。然后计算它 - 如果禁用自动计算 - 并将结果粘贴为值：

Sub solution2()

Dim oldRow As Integer
Dim newRow As Integer
Dim lrow_output As Integer  'variable indicating last fulfilled row
Dim WB_Input As Workbook
Dim WB_Output As Workbook
Dim WS_Input As Worksheet
Dim WS_Output As Worksheet
Dim funcStr As String

Set WB_Input = Workbooks("WB_Input.xlsb")
Set WB_Output = Workbooks("WB_Output.xlsb")

Set WS_Input = WB_Input.Worksheets("AM_quote-overview_sales-inputs")
Set WS_Output = WB_Output.Worksheets("Sheet1")

With WS_Output
    lrow_output = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

With WS_Input
    funcStr = "=IFERROR(VLOOKUP(" & Cells(1, 1).Address(False, False) & "," & "'[" & WB_Input.Name & "]" & .Name & "'!" & Range(.Columns(1), .Columns(2)).Address & ",2,0),"""")"
End With


With WS_Output
    .Cells(1, 2).Formula = funcStr
    .Cells(1, 2).Copy
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteFormulas
    WS_Output.Calculate
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).Copy
    Range(.Cells(1, 2), .Cells(lrow_output, 2)).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End With

End Sub

如果我正确理解了您的问题并提供了正确的解决方案，请告诉我 - 如果没有，请告诉我哪些假设是错误的，以便我进行调整。