![](/img/trans.png)
[英]Excel VBA Macro for opening and loading information from one workbook to another
[英]excel vba macro to import information from one book to another
我有2本工作簿,第1本和第2本。
书籍1有3列。
书籍2有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号都匹配,则应该输入相关的乐队编号。
我如何修改代码才能做到这一点?
我希望这是您要寻找的东西吗? 您需要匹配两列,因此将这两列都放入字典中。
'.......
'-------------------------------------------------------------------------
'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中
如果不是必须使用新代码,则可以重新运行此Sub,这次比较PO编号,然后删除比较不适合的那些行。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.