Question

我是VBA Excel新手。

注意：

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

问题：

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

在工作簿2 中，列A 包含主题信息词，其中一些与我在AM_quote-overview_sales-inputs Sheet中的相似，有些则不在列中B.我需要在匹配时从工作簿1表的列B（AM_quote-overview_sales-inputs）复制值。

我想在工作簿2（工作表1）中使用一个宏，它将A列中的主题信息值与工作簿1工作表A列中的主题信息进行比较（AM_quote-overview_sales-inputs）然后将工作簿1工作表B列中的值（AM_quote-overview_sales-inputs）复制到工作簿2的工作表B（工作表1）。

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

我需要比较2列，并将工作簿1工作表（AM_quote-overview_sales-输入）的B列的值复制到工作簿2（工作表1）的B列，以获取两个工作表A列中的比较或匹配的单词。 / p>

有关详细信息，请查看下图。

代码：

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）数据 WorkBook 1 Sheet (AM_quote-overview_sales-inputs) Data

2工作簿2（表1）数据 Workbook 2 (Sheet 1) Data

示例：

    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 和匹配的单词将工作簿1的 的B列中的单词值3,4复制到工作簿2的 在言语面前。

在宝马面前，我需要像4这样的价值，所以在匹配单词之后，我需要在练习册2的Col 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个额外的评论，这些评论不会影响结果，但可能会影响效率：

您也可以跳过i变量，因为您可以通过循环中使用的变量管理所有内容。
您不必每次都将输出单元格设置为“” - 使用相反的循环顺序，您可以在内循环之前执行此操作（我将在下面的示例中显示）。
您可以搜索它，而不是将修正最大行放在循环中 - 请参阅下面的示例，我在其中确定lrow_Input和lrow_Output的值，而不是使用' 1170' 。

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

WB_Input.xlsb是您拥有'AM_quote-overview_sales-inputs'工作表的文件，并且您希望匹配此WB中的值（结构如您的示例所示 - col A和col B将被使用）
WB_Output.xlsb是您希望在col A中为col A中的值得到结果的文件：
我不知道你想把你的代码放在哪里（在输入或输出文件中，这就是为什么我把文件的确切名称放在一起 - 一旦你决定你可以将行分配工作簿替换为对象（例如{{1 }}）将其分配给Set WB_Input = Workbooks("WB_Input.xlsb")。

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

ThisWorkbook

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

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列，并将匹配项的值从工作簿1中的下一列复制到工作簿2中的空列对照匹配项

1 个答案: