VBA删除匹配第一& 2个工作表中的姓氏 [英] VBA remove matching first & last names across 2 worksheets

问题描述

我需要帮助修改此代码以匹配2个工作表中的第一个和最后一个名称，然后从子表中删除匹配项。目前，它只匹配1列的2列。详细信息：

I need help modifying this code to match First and Last names across 2 worksheets, then remove matches from the Sub sheet. At the moment it only matches 2 columns across 1 sheet. Specifics:

如何更改此代码，因此Sheet 1列B上的名称与sheet 2列'E'&所有匹配项都从Sheet 1中删除，同样重复Sheet 1列C到Sheet 2列F。

How do i change this code so Names on 'Sheet 1' Column 'B' are Matched to names on 'sheet 2' column 'E' & all matches are deleted from 'Sheet 1". Same is repeated for 'Sheet 1' Column 'C' to 'Sheet 2' Column '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

推荐答案

通过Sheet1列B中的所有值循环。如果在Sheet2列E中找到该值，则Sheet1中的整行将被删除。然后它循环遍历Sheet1列C中的所有值。如果在Sheet2列F中找到该值，Sheet1中的整个行将被删除。

Loops through all values in Sheet1 Column B. If that value is found in Sheet2 Column E, the entire row in Sheet1 is deleted. Then it loops through all values in Sheet1 Column C. If that value is found in Sheet2 Column F, the entire row in Sheet1 is deleted.

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

这篇关于VBA删除匹配第一& 2个工作表中的姓氏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！