VBA 두 워크 시트에서 일치하는 이름 및 성을 제거하십시오.

Question

두 개의 워크 시트에서 이름과 성을 일치 시키려면이 코드를 수정 한 다음 서브 시트에서 일치 항목을 제거하는 데 도움이 필요합니다. 현재는 1 시트에 2 열만 일치합니다. 세부 사항 :

'시트 1'열 'B'의 이름이 '시트 2'열 'E'의 이름과 일치하도록 & '시트 1'에서 모든 일치가 삭제됩니다. 동일한 반복됩니다. '시트 2' '시트 (1)'열 'C'열 '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

루프 그 값을 삽입하거나 열 E에 있으면 시트 1 열 B. 모든 값을 통해, 시트 1의 전체 행 이 삭제 된 다음 Sheet1 열 C의 모든 값을 반복합니다.이 값이 Sheet2 열 F에 있으면 Sheet1의 전체 행이 삭제됩니다.

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