VBA删除匹配数据的行

我构建了一个宏，用于传输工作表1和工作表2上的两个csv数据文件，并重命名这两个工作表。我想构建另一个宏，将两组数据之间的所有不匹配行复制到新的xlsx文件中。为了识别匹配的数据，我需要写一些东西来实现这一点：

如果sheet1中a列的单元格值在sheet2的a列中具有匹配值，则我需要比较每张图纸上的对应行：sheet1的B列到sheet2的C列，sheet1的D列到sheet2的E列，sheet1的F列到sheet2的G列，sheet1的G列到sheet2的H列，将sheet1的H列复制到sheet2的I列，将sheet1的J列复制到sheet2的J列，并将sheet1中所有在sheet2中没有匹配行的数据行复制到新文件中

以下是我的代码草案：

Sub SupprLignes()
Dim rowCount1 As Long, rowCount2 As Long
Dim rng1 As Range, rng2 As Range, MyCell As Range, Mycell2 As Range
Dim currentRow As Long
Dim WB As Workbook
Dim WS As Worksheet

Set WB = Workbooks.Add

ActiveWorkbook.SaveAs "C:\Users\Phil\Desktop _
\Report_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

rowCount1 = Workbooks("Received_temp.xlsx").Worksheets _
("Received").Range("A2").SpecialCells(xlCellTypeLastCell).Row

Set rng1 = Workbooks("Received_temp.xlsx").Worksheets _
("Received").Range("A2:A" & rowCount1)

rowCount2 = Workbooks("Received_temp.xlsx").Worksheets _
("NotReceived").Range("A2").SpecialCells(xlCellTypeLastCell).Row
Set rng2 = Workbooks("Received.xlsx").Worksheets _
("NotReceived").Range("A2:A" & rowCount2)

Dim sheet1() As Variant
ReDim sheet1(rowCount1 - 1, 2)

currentRow = 0

For Each MyCell In rng1.Cells
    For Each Mycell2 In rng2.Cells
        If Mycell2.Value = MyCell.Value And Mycell2.Offset(0, 5).Value = _
MyCell.Offset(0, 5).Value And Mycell2.Offset(0, 2).Value = _
MyCell.Offset(0, 2).Value Then

            Workbooks("Received_temp.xlsx").Worksheets _
("Received").Rows(Cell.Row).Copy
                Destination:=Workbooks("Received.xlsx").Worksheets _
("Received").Range("A" & currentRow)

            currentRow = currentRow + 1

            GoTo NextIteration
        End If
    Next cell2
Next Cell

NextIteration:
ThisWorkbook.Sheets(1).Rows(Cell.Row).Copy Destination:=ThisWorkbook.Sheets(4).Range("A" & currentRow)

End Sub

---

我知道For Next是错误的，但我知道我的方向不对，所以我暂时就这么说。

对于初学者，在工作表中添加一列并插入匹配函数。这将告诉您相应搜索值的行号#不匹配的行将显示N/A。通过使用宏记录器以RC格式保存公式，然后将其复制到工作表底部，可以自动填充匹配列

现在，在匹配行列中循环查找#N/A

例如：

Dim aCell as range
Dim aRange as range
dim tWS as worksheet
dim lrow as long

Application.calculation = xlmanual
set tWS = thisworkbook.sheets("Sheet2")  '*** Target worksheet to copy not founds

set arange = intersect(activesheet.range("A1"), activesheet.usedrange)
for each acell in arange
   if isnull(acell) then
     lrow = tws.range("A65536").end(xlup).row + 1
    copy acell.entirerow tws.range("A" & Lrow)
   endif
next acell
application.calculation = xlAutomatic

---

完成后，您可以将TWS复制到另一个工作簿，这比链接到新工作簿并一次追加一条记录更容易。

您的代码做了哪些不应该做的事情，或者没有做您希望它做的事情？乍一看，我不认为每个人都有。。。接下来的循环肯定是错误的方法；我想问的地方是关于GoTo的下一个问题。如果您将其替换为退出，那么您将不再查看Rng1中的“this”单元格，而不再查看Rng2中的所有单元格，而是继续查看Rng1中的其余单元格。看看这是否对你有好处，让我们知道事情偏离了你想要的方向。无论如何，你应该用

Next

替换

Next cell2

和

Next Cell

。