vba - 比较并匹配 2 列，并将匹配项目的值从工作簿 1 中的下一列复制到工作簿 2 中的空列(针对匹配项目)

Question

我是 VBA Excel 新手。

注意:

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

问题:

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

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

我想要工作簿 2(工作表 1) 中的宏将 A 列中存在的主题信息的值与工作簿 1 工作表 A 列中存在的主题信息 (AM_quote-overview_sales-inputs) 进行比较然后将工作簿 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 个工作簿 1 个工作表 (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 表 1 中使用一个宏，该宏将从 A 列 中选取 BMW 等值，并与 A 列中的这些值相匹配工作簿 1 工作表 AQR 和匹配的单词会将 3、4 等单词的值从工作簿 1 的 B 列复制到工作簿 2 的 B 列在单词前面。

在 BMW 前面，我需要像 4 这样的值，因此在匹配单词之后，我需要工作簿 2 的 B 列中的 4。

如果没有值匹配或在工作簿 2 中添加了新行，其中不包含某些单词或值，则应将其保留为空，并且我需要将匹配单词的值复制到相应单词的前面。

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. 您可以搜索它，而不是将修复最大行放入循环中 - 请参阅下面的示例，其中我标识了 lrow_Input 的值和lrow_Output而不是使用“1170”。

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

1. WB_Input.xlsb 是您拥有“AM_quote-overview_sales-inputs”工作表的文件，并且您希望匹配此 WB 中的值(结构如您的示例中所示 - 使用 col A 和 col B)

2. WB_Output.xlsb 是您希望在 B 列中获得 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

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