[VBA] 2개의 조건(다중조건)이 일치하는 데이타 찾기

두개의 조건이 일치하는 데이터를 찾아서 중복이라고 표시해주는 VBA 코드이다.

전화번호와 이름이 일치하는 데이터만 중복이라고 표시를 한다.

다중조건 Find.xlsm

Sub 다중열조건Find()
    Dim sht1, sht2    As Worksheet   '// 시트(Sheet)를 넣을 변수   
    Dim Target As Range     '// 검사할 시트의 범위 구간
    Dim rngAll As Range, FindCell As Range  '// 현재시트의 구간 범위
    Dim C As Range, strAddr As String   '// 영역변수 및 주소를 저장할 변수
    Dim i As Long
   
    Application.StatusBar = True
    Set sht1 = Sheets("Main")   '// Main 워크시트는 현재 시트
    Set sht2 = Sheets("Data")   '// Data 워크시트는 데이터가 있는 Target 시트
    Set rngAll = sht1.Range(sht1.Cells(2, "B"), sht1.Cells(Rows.Count, "B").End(3))
    Set Target = sht2.Range(sht2.Cells(2, "B"), sht2.Cells(Rows.Count, "B").End(3))
   
    sht1.Select
    rngAll.Offset(0, 2).ClearContents   '// 결과 기록값 초기화
    rngAll.Offset(0, 3).ClearContents   '// 결과 기록값 초기화
   
    For Each FindCell In rngAll.Cells
        Application.StatusBar = "셀: " + FindCell.Address(0, 0) + " / " + FindCell + " 진행중..."
        Set C = Target.Find(what:=FindCell, Lookat:=xlWhole)
        '// Target 범위에서 FindCell 과 100% 일치하는 데이터를 찾아 C에 넣어라
        If Not C Is Nothing Then    '// 찾는 값이 있으면
            strAddr = C.Address     '// 최초 셀 주소를 기억하게 strAddr 에 저장
            Do  '// 무한 루프 시작
                If C.Offset(0, 1).Value = FindCell.Offset(0, 1).Value Then '// 옆의 셀이 서로 일치하면
                    i = i + 1
                    FindCell.Offset(0, 2) = "중복"    '// 현재 시트의 찾는셀 우측으로 2번째에 기록
                    If i > 1 Then
'                        FindCell.Offset(0, 2) = FindCell.Offset(0, 2) + vbNewLine + "중복"
                        FindCell.Offset(0, 3).Value = i   '// 같은 자료가 2개 이상이면 숫자를 기록
                    End If
                    Debug.Print "전화번호 : " & C.Offset(0, 1)
                End If
                Set C = Target.FindNext(C)   '// 다음셀을 찾음
            Loop While Not C Is Nothing And strAddr <> C.Address    '// 찾는 셀이 없거나 첫번째 셀이면 루프문 종료
            i = 0
        End If
    Next
    Application.StatusBar = "작업완료"

   Set rngAll = nothing    '// 메모리 비우기
End Sub

비교하려는 열의 값을 약간 확장해서 한다면 아래와 같이 수정해서 사용하면 된다.

    src_cell = 13   '// 비교하려는 열
    dst_cell = 13  '// 비교하려는 열

를 For 문 앞에 추가하고

            Do  '// 무한 루프 시작
                If C.Offset(0, dst_cell).Value = FindCell.Offset(0, src_cell).Value Then
                    FindCell.Offset(0, src_cell).Interior.ColorIndex = 28
                    C.Offset(0, dst_cell).Interior.ColorIndex = 28
                End If
                   
                FindCell.Interior.ColorIndex = 15    '// 회색으로 설정
                C.Interior.ColorIndex = 15
               
                Set C = Target.FindNext(C)   '// 다음셀을 찾음
            Loop While Not C Is Nothing And strAddr <> C.Address  '// 찾는 셀 없거나 첫번째 셀이면 루프문 종료