两个工作簿之间的数据匹配和基于的粘贴数据

Question

我正在处理的情况是，有一个表，账号在第一列，金额在第五列，"F"或"p"在第七列。账号与第一列中另一工作簿上的账号相匹配。如果在表的第七列中(在源工作簿中，有一个"F"，则应将该值复制、匹配并粘贴到目标工作簿第四列的同一行上。如果有"P"，则应该将该值匹配并粘贴在目标工作簿第五列的同行上。代码有效，但无法区分F或P。它将所有值粘贴到两列中。

Private Sub CommandButton2_Click()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet
Dim cell As Range
Dim SrchRng As Range
Set Dic = CreateObject("Scripting.Dictionary")
Set w1 = Workbooks("HF Pricing Template1").Sheets("Tables")
Set w2 = Workbooks("Book1").Sheets("Sheet1")
Set SrchRng = Range("Table3[Price_Type]")
For Each cell In SrchRng
If cell.Value = "P" Then
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("M5:M" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 5).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(, 3).Value = Dic(key)
End If
Next
Next
End If
Next cell
For Each cell In SrchRng
If cell.Value = "P" Then
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("M5:M" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 5).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(, 4).Value = Dic(key)
End If
Next
Next
End If
Next cell
End Sub

Answer 1

Dim source_wb As Workbook
Dim dest_wb As Workbook
Dim source_ws As Worksheet
Dim dest_ws As Worksheet
'set workbooks/sheets
Set source_wb = Workbooks("HF Pricing Template1")
Set source_ws = source_wb.Worksheets("Tables")
Set dest_wb = Workbooks("Book1")
Set dest_ws = dest_wb.Worksheets("Sheet1")
Dim source_lr As Integer
Dim dest_lr As Integer
'get last row of data in each sheet for column 1 (the account numbers)
'checks for account number list in column "a" change where applicable
source_lr = source_ws.Cells(Rows.Count, "M").End(xlUp).Row
dest_lr = dest_ws.Cells(Rows.Count, "A").End(xlUp).Row

'this starts checking for account numbers at row 2 change where applicable
For source_row = 5 To source_lr
''this start checking for account numbers at row 2 change where applicable
For dest_row = 2 To dest_lr
'check if account numbers match
' change column as applicable
If source_ws.Cells(source_row, "M") = dest_ws.Cells(dest_row, "A") Then
'if column 7  in source contains p then copy to column 4 in dest ws
'change column where applicable
If source_ws.Cells(source_row, "S") = "P" Then
dest_ws.Cells(dest_row, "D") = source_ws.Cells(source_row, "M")
Exit For
'if column 7  in source contains f then copy to column 5 in dest ws
' change column where applicable
ElseIf source_ws.Cells(source_row, "S") = "F" Then
dest_ws.Cells(dest_row, "E") = source_ws.Cells(source_row, "M")
Exit For
End If
End If
Next
Next

Answer 2

这个完整的重写怎么样。

阅读评论进行解释

'compare text (ignore case)
option compare text 
dim source_wb as workbook
dim dest_wb as workbook
dim source_ws as worksheet
dim dest_ws as worksheet
'set workbooks/sheets
set source_wb = workbooks("HF Pricing Template1")
set source_ws = source_wb.worksheets("Table")
set dest_wb = workbooks("Book1")
set dest_ws = dest_wb.worksheets("Sheet1")
dim source_lr as integer
dim dest_lr as integer
'get last row of data in each sheet for column 1 (the account numbers)
'checks for account number list in column "a" change where applicable
source_lr = source_ws.cells(rows.count, "M").end(xlup).row
dest_lr = dest_ws.cells(rows.count, "A").end(xlup).row

'this starts checking for account numbers at row 2 change where applicable
for source_row = 2 to source_lr
''this start checking for account numbers at row 2 change where applicable
for dest_row = 2 to dest_lr
'check if account numbers match
' change column as applicable 
if source_ws.cells(source_row, "M") = dest_ws.cells(dest_row, "A") then
'if column 7  in source contains p then copy to column 4 in dest ws
'change column where applicable
if source_ws.cells(source_row, "S") = "p" then
dest_ws.cells(dest_row,"D") = source_ws.cells(source_row, "R")
exit for

'if column 7  in source contains f then copy to column 5 in dest ws
' change column where applicable
elseif source_ws.cells(source_row, "S") = "f" then
dest_ws.cells(dest_row, "E") = source_ws.cells(source_row, "R")
exit for
end if
end if
next dest_row
next source_row

请注意，我不在windows机器上，现在不能测试这个，但它应该能按预期工作。