VBA删除两个工作表中匹配的第一个和最后一个名字

我需要帮助修改此代码以匹配2工作表中的名字和姓氏，然后从子工作表中删除匹配。 目前它只能在1张纸上匹配2列。 具体细节：

如何更改此代码，使'Sheet 1'列'B'上的名称匹配'sheet 2'列'E'上的名称，所有匹配项都从'Sheet 1'中删除。 'C'到'Sheet 2'栏'F'。

Sub CompareNames() Dim rngDel As Range Dim rngFound As Range Dim varWord As Variant Dim strFirst As String With Sheets("ADULT Sign On Sheet") For Each varWord In Application.Transpose(.Range("A1", .Cells(.Rows.Count,"A").End(xlUp)).Value) If Len(varWord) > 0 Then Set rngFound = .Columns("B").Find(varWord, .Cells(.Rows.Count, "B"), xlValues, xlPart) If Not rngFound Is Nothing Then strFirst = rngFound.Address Do If Not rngDel Is Nothing Then Set rngDel = Union(rngDel, rngFound) Else Set rngDel = rngFound Set rngFound = .Columns("B").Find(varWord, rngFound, xlValues, xlPart) Loop While rngFound.Address <> strFirst End If End If Next varWord End With If Not rngDel Is Nothing Then rngDel.Delete Set rngDel = Nothing Set rngFound = Nothing End Sub 

Answer 1

循环浏览Sheet1列B中的所有值。如果在Sheet2列E中find该值，则Sheet1中的整个行被删除。 然后它循环通过Sheet 1列C中的所有值。如果在Sheet 2列F中find该值，Sheet 1中的整个行将被删除。

 Sub DeleteCopy() Dim LastRow As Long Dim CurRow As Long Dim DestLast As Long LastRow = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row DestLast = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row For CurRow = 2 To LastRow 'Assumes your first row of data is in row 2 If Not Sheets("Sheet2").Range("E2:E" & DestLast).Find(Sheets("Sheet1").Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then Sheets("Sheet1").Range("B" & CurRow).Value = "" Else End If Next CurRow LastRow = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row DestLast = Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Row For CurRow = 2 To LastRow 'Assumes your first row of data is in row 2 If Not Sheets("Sheet2").Range("F2:F" & DestLast).Find(Sheets("Sheet1").Range("C" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then Sheets("Sheet1").Range("C" & CurRow).Value = "" Else End If Next CurRow End Sub 

Answer 2

试试这个，你必须用第一个标准调用两次，然后再用第二个标准调用它

我想我已经为第一个标准正确设置了

 Sub DeleteIfMatchFound() Dim SearchValues As Variant Dim wsSource As Worksheet, wsTarget As Worksheet Dim sLR As Long, tLR As Long, i As Long Set wsSource = ThisWorkbook.Worksheets("Sheet1") Set wsTarget = ThisWorkbook.Worksheets("Sheet2") sLR = wsSource.Range("B" & wsSource.Rows.Count).End(xlUp).Row tLR = wsTarget.Range("E" & wsSource.Rows.Count).End(xlUp).Row SearchValues = wsSource.Range("B2:B" & sLR).Value For i = 1 To (tLR - 1) If Not IsError(Application.match(SearchValues(i, 1), wsTarget.Range("E2:E" & tLR), 0)) Then wsTarget.Rows(i + 1).Delete End If Next i End Sub