Question

我构建了一个宏，它在表1和表2上传输2个csv数据文件并重命名这2个表。我想构建另一个宏，将两组数据中的所有非匹配行复制到一个新的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是错的，但我知道我没有朝着正确的方向前进，所以我现在就这样说了。

Answer 1

对于初学者，在工作表中添加一列并插入匹配功能。这将告诉您相应搜索值的行号。 #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复制到另一个工作簿，这比链接到新工作簿并一次附加一个记录更容易。

VBA删除匹配数据的行

1 个答案: