Excel VBA宏將信息從一本書導入到另一本書

Question

我有2本工作簿，第1本和第2本。

書籍1有3列。

1. 電話號碼
2. 樣式編號
3. 訂單號

書籍2有2列填充。

1. 樣式編號
2. 訂單號

最初，我是通過比較兩本書的樣式編號來導入第一本書到第二本書中的樂隊編號信息。

當兩本書的樣式編號匹配時，書1的樂隊編號將導入書2。

這是代碼：

Sub procedure2()
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")


    'source
    Set w1 = Workbooks("book1.xlsm").Worksheets(1)

    'destination
    Set w2 = Workbooks("book2.xlsm").Worksheets(1)

    '-------------------------------------------------------------------------
    'get the last row for w1
    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
    '-------------------------------------------------------------------------
    ' fill dictionary with data for searching
    For Each oCell In w1.Range("C2:C" & 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(, -2).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("D2:D" & 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

它成功地工作。

但是現在我想通過比較書1和書2中包含的樣式號和PO號來導入信息，樂隊編號。

如果兩本書的樣式編號都匹配，並且兩本書的PO號都匹配，則應該輸入相關的樂隊編號。

我如何修改代碼才能做到這一點？

Answer 1

我希望這是您要尋找的東西嗎？ 您需要匹配兩列，因此將這兩列都放入字典中。

'.......
'-------------------------------------------------------------------------
'get the last row for w1
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
'-------------------------------------------------------------------------
' fill dictionary with data for searching
For Each oCell In w1.Range("C2:C" & i)
    'row number for duplicates
    z = 1: While Dic.exists(oCell.Value & "_" & oCell.Offset(, 3).Value & "_" & z): z = z + 1: Wend
    'add data with row number to dictionary
    If Not Dic.exists(oCell.Value & "_" & oCell.Offset(, 3).Value & "_" & z) Then
        Dic.Add oCell.Value & "_" & oCell.Offset(, 3).Value & "_" & z, oCell.Offset(, -2).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("D2:D" & i)
    'determinate row number for duplicated values
    z = 1: While Dic2.exists(oCell.Value & "_" & oCell.Offset(, 3).Value & "_" & z): z = z + 1: Wend
    'search
    For Each key In Dic
        If oCell.Value & "_" & oCell.Offset(, 3).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 & "_" & oCell.Offset(, 3).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 & "_" & oCell.Offset(, 3).Value & "_" & z) Then
        Dic2.Add oCell.Value & "_" & oCell.Offset(, 3).Value & "_" & z, ""
    End If
Next

順便說一句，當我測試您的代碼時：

Set w1 = Workbooks("book1.xlsm").Worksheets(1)

它給了我一個錯誤。 應該是這樣嗎？ 和W2相同

Set w1 = Workbooks.open(FULL_PATH_TO_WORKBOOK).Worksheets(1)

可以通過以下方式獲取FULL_PATH_TO_WORKBOOK

Thisworkbook.path & Application.PathSeparator & "book1.xlsm"

如果將宏放在book1中

Answer 2

如果不是必須使用新代碼，則可以重新運行此Sub，這次比較PO編號，然后刪除比較不適合的那些行。