excel vba宏，以匹配来自两个不同工作簿的单元格，并相应地进行复制和粘贴 [英] excel vba macro to match cells from two different workbooks and copy and paste accordingly

问题描述

我有2个工作簿，即工作簿A和工作簿B.每个工作簿都有一个表.工作簿A有2列.全部三列均已填充.

i have 2 workbooks, workbook A and workbook B. Each workbook has a table. workbook A has 2 columns. All three columns are filled.

1. product_id
2. 机器编号和

工作簿B具有相同的2列，但仅填充了Product_id列.其余1列空缺.

Workbook B has the same 2 columns but only one column, Product_id, is filled. The other 1 column is vacant.

我需要匹配两个工作簿的product_id的单元格.如果在工作簿A中找到的product_id与工作簿B相匹配，则应将该产品ID的机器编号从工作簿A复制到工作簿B.

I need to match the cells of product_id of both workbooks. If the product_id found in workbook A matches workbook B, then the machine number of that product id should be copied from workbook A to workbook B.

我已经使用以下代码执行了此操作:

I have performed this using this code:

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long

Application.ScreenUpdating = False

Set w1 = Workbooks("workbookA.xlsm").Worksheets("Sheet1")
Set w2 = Workbooks("workbookB.xlsm").Worksheets("Sheet1")


For Each c In w1.Range("A2", w1.Range("A" & Rows.Count).End(xlUp))
  FR = 0
  On Error Resume Next
  FR = Application.Match(c, w2.Columns("A"), 0)
  On Error GoTo 0
  If FR <> 0 Then w2.Range("C" & FR).Value = c.Offset(, 0)
Next c
Application.ScreenUpdating = True
End Sub

在产品编号栏中有一个显示机器4"的单元格.不会复制此单元格并将其粘贴到工作簿B中的相应product_id值旁边.

There is a cell that says "machine 4" in product number column. This cell does not get copied and pasted alongside the corresponding product_id value in workbook B.

将复制并粘贴产品ID的其余机器编号.

The rest of the machine numbers for the product ids get copied and pasted accordingly.

这些是结果的屏幕截图

These are the screenshots of results

第一个屏幕截图是 工作簿B

The first screenshot is Workbook B

第二个屏幕截图是 工作簿A

The second screenshot is Workbook A

我不知道为什么会这样，有人可以告诉我原因吗?

............................................... .................................... 更新

................................................................................ UPDATE

我发现，当product_id(style_number)重复出现时，会出现问题中描述的问题.

I found that the issue ive descriped in the question arises when the product_id(style_number) repeats.

在两个工作簿中的2个单元格中是否存在product_id GE 55950.然后，当我执行宏时，仅检测到一个单元.

Say if product_id GE 55950 is present in 2 cells,in both workbooks. Then when i execute the macro only one of the cells is detected.

我在两个答案中都尝试了编码，但是都没有解决这个问题.

I tried the coding in both answers but neither solved this problem.

下面是结果的屏幕截图.

Below is a screenshot of the results.

在屏幕快照中，未显示机器7的单元.有人可以告诉我为什么会这样吗?

推荐答案

尝试一下

Sub UpdateW2()
    Dim Dic As Object, key As Variant, oCell As Range, i&
    Dim w1 As Worksheet, w2 As Worksheet

    Set Dic = CreateObject("Scripting.Dictionary")
    Set w1 = Workbooks("workbookA.xlsm").Sheets("Sheet1")
    Set w2 = Workbooks("workbookB.xlsm").Sheets("Sheet1")

    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row

    For Each oCell In w1.Range("D2:D" & i)
        If Not Dic.exists(oCell.Value) Then
            Dic.Add oCell.Value, oCell.Offset(, -3).Value
        End If
    Next

    i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row

    For Each oCell In w2.Range("A2:A" & i)
        For Each key In Dic
            If oCell.Value = key Then
                oCell.Offset(, 2).Value = Dic(key)
            End If
        Next
    Next
End Sub

针对新要求的更新

使用此

Sub UpdateW2()
    Dim key As Variant, oCell As Range, i&, z%
    Dim w1 As Worksheet, w2 As Worksheet
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim Dic2 As Object: Set Dic2 = CreateObject("Scripting.Dictionary")
    Set w1 = Workbooks("workbookA.xlsm").Sheets("Sheet1")
    Set w2 = Workbooks("workbookB.xlsm").Sheets("Sheet1")
    '-------------------------------------------------------------------------
    'get the last row for w1
    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
    '-------------------------------------------------------------------------
    ' fill dictionary with data for searching
    For Each oCell In w1.Range("D2:D" & i)
        'row number for duplicates
        z = 1: While Dic.exists(oCell.Value & "_" & z): z = z + 1: Wend
        'add data with row number to dictionary
        If Not Dic.exists(oCell.Value & "_" & z) Then
            Dic.Add oCell.Value & "_" & z, oCell.Offset(, -3).Value
        End If
    Next
    '-------------------------------------------------------------------------
    'get the last row for w2
    i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
    '-------------------------------------------------------------------------
    'fill "B" with results
    For Each oCell In w2.Range("A2:A" & i)
        'determinate row number for duplicated values
        z = 1: While Dic2.exists(oCell.Value & "_" & z): z = z + 1: Wend
        'search
        For Each key In Dic
            If oCell.Value & "_" & z = key Then
                oCell.Offset(, 2).Value = Dic(key)
            End If
        Next
        'correction of the dictionary in case
        'when sheet "A" has less duplicates than sheet "B"
        If oCell.Offset(, 2).Value = "" Then
            Dic2.RemoveAll: z = 1
            For Each key In Dic
                If oCell.Value & "_" & z = key Then
                    oCell.Offset(, 2).Value = Dic(key)
                End If
            Next
        End If
        'add to dictionary already passed results for
        'the next duplicates testing
        If Not Dic2.exists(oCell.Value & "_" & z) Then
            Dic2.Add oCell.Value & "_" & z, ""
        End If
    Next
End Sub

下面的输出结果

这篇关于excel vba宏，以匹配来自两个不同工作簿的单元格，并相应地进行复制和粘贴的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！