excel vbamacros将信息从一本书导入另一本书

我有2本工作簿的书1和书2。

书1有3个填充列。

1. 电话号码
2. 样式编号
3. 订单号

第2册有2个填充列。

1. 样式编号
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中包含的样式编号和采购订单编号来导入信息，编号。

如果两本书的风格编号匹配，并且两本书的采购订单编号相匹配，则需要导入相关的编号。

我如何修改代码才能做到这一点？

Answer 1

如果新代码不是强制性的，你可以重新运行这个Sub，这次比较采购订单号，然后删除比较不适合的行。

Answer 2

这是你在找什么，我希望？ 您需要匹配两列，以便将两列都放到字典中。

 '....... '------------------------------------------------------------------------- '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 

顺便说一句，当我testing你的代码：

 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" 

如果你把macros放在book1中