[英]Compare two worksheets, find first match and paste, then delete source row
我有两个工作表,并且想在活动工作表中找到第一个匹配项时从第二个工作表(Sheet1)中粘贴两个单元格。 然后删除Sheet1中的源行。 我无法从活动工作表的最后一行开始循环,因为我想从匹配的顶部开始填充第一行。 我也正在努力激活Sheet1以删除该行:
Sub moveRecords()
Dim i, j As Long
With ActiveSheet
'need to work down in active sheet in order to populate the first match with cells 1 & 2
For i = 2 To 100
For j = 2 To 1000
If Cells(n, 1).Value = Sheets("Sheet1").Cells(j, 1).Value _
And Cells(n, 2).Value = Sheets("Sheet1").Cells(j, 2).Value Then
Cells(n, 7).Value = Sheets("Sheet1").Cells(j, 1).Value
Cells(n, 8).Value = Sheets("Sheet1").Cells(j, 2).Value
'need to delete the source row in Sheet1
End If
Next j
Next n
End With
End Sub
这是一种略有不同的方法,因为您要删除整行,因此很难正确跟踪i或j变量,因此此代码将所有复制和粘贴标记为必须删除的行,然后将其全部删除,我对您的要求感到困惑,但我认为就是这样=]
Sub moveRecords()
For j = 2 To 100
If Sheets("Sheet1").Cells(j, 1).Value = Sheets("Sheet2").Cells(j, 1).Value _
And Sheets("Sheet1").Cells(j, 2).Value = Sheets("Sheet2").Cells(j, 2).Value Then
Sheets("Sheet1").Cells(j, 7).Value = Sheets("Sheet2").Cells(j, 1).Value
Sheets("Sheet1").Cells(j, 8).Value = Sheets("Sheet2").Cells(j, 2).Value
Worksheets("Sheet2").Cells(j, 1) = "Delete"
End If
Next
For i = 2 To 100
If Worksheets("Sheet2").Cells(i, 1) = "Delete" Then
Worksheets("Sheet2").Cells(i, 1).EntireRow.Delete
i = i - 1
End If
Next
End Sub
如果您在sheet1和sheet2上的数据如下所示:
解决方法如下:
Sub test()
Set ExcelApp = CreateObject("Excel.Application")
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
Set ws1 = wb.Worksheets("Sheet2")
Set Rng = ws.UsedRange
RowCount = Rng.Rows.Count
Set Rng1 = ws1.UsedRange
RowCount1 = Rng.Rows.Count
For n = 1 To RowCount
For j = 1 To RowCount1
If ws.Cells(n, 1).Value = ws1.Cells(j, 1).Value _
And ws.Cells(n, 2).Value = ws1.Cells(j, 2).Value Then
ws.Cells(n, 7).Value = ws1.Cells(j, 1).Value
ws.Cells(n, 8).Value = ws1.Cells(j, 2).Value
ws1.Cells(j, 1).EntireRow.Delete
'To set the search to start from top row
j = 0
End If
Next j
Next n
End Sub
输出将是:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.