希望将sheet2上同一行的第1列和第2列的值与sheet1上同一行的第1列和第2列的值相匹配 . 然后,将整行的sheet1匹配复制到相同行sheet2的第3列的第3行的第3行复制值的第3行复制到sheet3上的粘贴行的末尾 .
IF Sheet2 Row First&Last (column1&2) Name match Sheet1 Row First&Last (column1&2)
THEN
Copy Sheet1 Row, paste to Sheet3 @ next blank Row. Copy Sheet2 Row column 3+4 @ end of previously pasted Row on Sheet3
这是我到目前为止所做的,现在没有做任何事情,但我已经从一些工作宏拼凑起来试图完成我所追求的目标 . 我无法找到“Copy Sheet2 Row column 3 4 @ previous of Sheet on Sheet on Sheet 3”的示例,所以我只想对代码应该去的那一行进行描述 .
{Sub Match_Copy_AddValues()
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False
Set s1 = ActiveSheet 'List with dump data'
Set s2 = Sheets("Sheet 2") 'List of names to match, and additional information to be added'
Set s3 = Sheets("Sheet 3") 'Worksheet to copy rows of matched names'
Dim r As Long 'Current Row being matched?'
On Error GoTo fìn
Set ws2 = Sheets("Sheet 2")
With Sheets("Sheet 1")
r = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(Rows.Count, 2).End(xlUp).Row) 'Defines # of rows to apply If/Then to?'
For r = Application.Sum(v) To 2 Step -1 'Each time If/Then is ran, reduce # of rows to apply If/Then to?'
If CBool(Application.CountIfs(ws2.Columns(1), .Cells(r, 1).Value, ws2.Columns(2), .Cells(r, 2).Value)) Then _
.Rows(r).EntireRow.Copy s3.Cells(K, 1) 'Compares value in (r)row column 1 and 2, sheet2, to sheet1(activesheet), if equal THEN copies entire (r)row onto sheet3 @ next empty row'
'take (r)row of match and copy value of column 3 and 4 sheet2 onto the end of previously pasted row on sheet3'
Next r
End With
fìn:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub}
1 回答
下面的代码并不像你的尝试所表达的那样完成所有事情,但我用非常简单的语言编写它,这样你肯定能够将它te回到你已经超越它不应该去的地方 .