EXCEL VBA

[ 엑셀 VBA ] 두 범위의 값 비교하기, VBA로 입력받은 두 범위 비교하기

카루루1007 2024. 11. 12. 18:21
728x90
반응형

입력된 두 범위의 값을 비교하는 코드입니다.

 

 전체코드

 

Option Explicit

Sub CompareRangesWithInput()
    Dim ws As Worksheet
    Dim rng_A As Range, rng_B As Range
    Dim cell_A As Range, cell_B As Range
    Dim dict_A As Object, dict_B As Object
    Dim commonValues As String, only_A As String, only_B As String
    Dim msg As String
    Dim answer As VbMsgBoxResult
    Dim input_A As Range, input_B As Range
    
    ' 현재 시트 설정
    Set ws = ThisWorkbook.ActiveSheet
    
    ' 사용자로부터 A와 B 범위 입력 받기
    On Error Resume Next ' 오류 발생 시 처리 (잘못된 입력 방지)
    
    Set input_A = Application.InputBox("비교할 첫 번째 범위를 선택하세요:", "첫 번째 범위 입력", Type:=8)
    
    ' 취소 버튼을 누른 경우 처리
    If input_A Is Nothing Then
        MsgBox "첫 번째 범위가 선택되지 않았습니다. 프로그램을 종료합니다.", vbExclamation
        Exit Sub
    End If
    
    Set input_B = Application.InputBox("비교할 두 번째 범위를 선택하세요:", "두 번째 범위 입력", Type:=8)
    
    ' 취소 버튼을 누른 경우 처리
    If input_B Is Nothing Then
        MsgBox "두 번째 범위가 선택되지 않았습니다. 프로그램을 종료합니다.", vbExclamation
        Exit Sub
    End If
    
    On Error GoTo 0 ' 오류 처리 해제
    
    ' Dictionary 객체 생성 (중복 제거 및 빠른 검색을 위해)
    Set dict_A = CreateObject("Scripting.Dictionary")
    Set dict_B = CreateObject("Scripting.Dictionary")
    
    ' A범위의 값을 Dictionary에 추가
    For Each cell_A In input_A
        If Not dict_A.exists(cell_A.Value) Then dict_A.Add cell_A.Value, cell_A.Address
    Next cell_A
    
    ' B범위의 값을 Dictionary에 추가
    For Each cell_B In input_B
        If Not dict_B.exists(cell_B.Value) Then dict_B.Add cell_B.Value, cell_B.Address
    Next cell_B
    
    ' 공통값 및 차이값 찾기
    commonValues = ""
    only_A = ""
    only_B = ""
    
    ' A범위와 B범위 비교
    For Each cell_A In input_A
        If dict_B.exists(cell_A.Value) Then
            commonValues = commonValues & cell_A.Value & ", "
        Else
            only_A = only_A & cell_A.Value & ", "
        End If
    Next cell_A
    
    For Each cell_B In input_B
        If Not dict_A.exists(cell_B.Value) Then
            only_B = only_B & cell_B.Value & ", "
        End If
    Next cell_B
    
    ' 마지막 쉼표 제거
    If Len(commonValues) > 0 Then commonValues = Left(commonValues, Len(commonValues) - 2)
    If Len(only_A) > 0 Then only_A = Left(only_A, Len(only_A) - 2)
    If Len(only_B) > 0 Then only_B = Left(only_B, Len(only_B) - 2)
    
    ' 결과 메시지 구성
    msg = "공통값: " & commonValues & vbCrLf & _
          "첫 번째 범위에만 있는 값: " & only_A & vbCrLf & _
          "두 번째 범위에만 있는 값: " & only_B & vbCrLf & _
          "색으로 구분하시겠습니까?"
    
    ' 메시지 박스 출력 및 사용자 응답 받기
    answer = MsgBox(msg, vbYesNo + vbQuestion, "비교 결과")
    
    ' 사용자가 색상 구분을 선택한 경우 색상 적용
    If answer = vbYes Then
        
        ' 첫 번째 범위에만 있는 값 빨간색 적용
        For Each cell_A In input_A
            If InStr(only_A, cell_A.Value) > 0 Then
                cell_A.Interior.Color = vbRed
            End If
        Next cell_A
        
        ' 두 번째 범위에만 있는 값 노란색 적용
        For Each cell_B In input_B
            If InStr(only_B, cell_B.Value) > 0 Then
                cell_B.Interior.Color = vbYellow
            End If
        Next cell_B
        
        MsgBox "색상이 적용되었습니다.", vbInformation
        
    Else
        MsgBox "프로그램을 종료합니다.", vbExclamation
        Exit Sub
        
    End If
    
End Sub

 

 실행 결과

 

아래와 같은 데이터를 준비했습니다.

 

코드를 실행하면 아래와 같이 범위를 입력하는 입력창이 나타납니다.

첫 번째 범위와 두 번째 범위를 입력받습니다.

 

범위를 모두 선택하면 아래와 같이 결과가 나타납니다.

 

공통값이 출력되고

첫 번째 범위에만 있는 값과 두 번째 범위에만 있는 값이 출력됩니다.

 

그리고 색으로 구분하겠냐는 메시지가 나타나면서

예를 누르면 색으로 구분하고

아니오를 누르면 프로그램을 종료합니다.

 

예를 누르면 아래 그림과 같이 색으로 구분됩니다.

 

함수를 사용한 비교 방법

1. 엑셀 두 데이터 비교하기, 누락된 값 찾기

2. 엑셀에서 두 열 비교하기, 엑셀 특정 항목 검색하기, 엑셀 값이 있는 지 확인하기

3. 엑셀 두 데이터 비교하기, 엑셀 데이터 비교하여 다른 부분 찾기

반응형

여기를 방문하시면 더 많은 엑셀 관련 자료를 확인할 수 있습니다.

엑셀 공부하기
VBA 공부하기

728x90
반응형