I have 2 workbooks book 1 and book 2.
Book 1 has 3 filled columns.
Book 2 has 2 filled columns.
At first I was importing the information, band number, from book 1 to book 2, by comparing style number of both books.
When the style number from both books match then the band number from book 1 is imported to book 2.
This is the code:
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
It works succesfully.
But now i want to import the information, band number, by comparing both the style number and PO numbers contained in book 1 and book 2.
If style numbers of both books match and PO numbers of both books match then the information, the related band number should be imported.
How do i modify the code in order to do this?
Is this something you are looking for, I hope? You need to match both columns so take both columns to the dictionary.
'.......
'-------------------------------------------------------------------------
'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
Btw, when I tested your code:
Set w1 = Workbooks("book1.xlsm").Worksheets(1)
It gave me an error. Should it be like this? and same for w2
Set w1 = Workbooks.open(FULL_PATH_TO_WORKBOOK).Worksheets(1)
where FULL_PATH_TO_WORKBOOK can be obtained by
Thisworkbook.path & Application.PathSeparator & "book1.xlsm"
if you put the macros in book1
如果不是必须使用新代码,则可以重新运行此Sub,这次比较PO编号,然后删除比较不适合的那些行。
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.