比较两个工作表,找到第一个匹配并粘贴,然后删除源行

时间:2015-03-12 21:16:05

标签: loops excel-vba delete-row vba excel

我有两个工作表,并希望在找到活动工作表中的第一个匹配时粘贴第二个工作表(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

2 个答案:

答案 0 :(得分:0)

这是一个稍微不同的方法,因为你想要删除整行,很难保持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

答案 1 :(得分:0)

如果您在sheet1和sheet2上的数据如下所示:

enter image description here enter image description here

以下是解决方案:

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

输出将是:

enter image description here enter image description here