excel vba macro to match cells from two different workbooks and copy and paste accordingly

后端 未结 2 1786
星月不相逢
星月不相逢 2021-01-03 14:37

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. Machine_
2条回答
  •  走了就别回头了
    2021-01-03 15:01

    try this

    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
    

    UPDATE AGAINST NEW REQUIREMENTS

    use this

    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
    

    output results below

    enter image description here

提交回复
热议问题