마산 학원 (이겨내자꼭)

I am that I am

Where there is a will, there is a way

카테고리 없음

Excel 추가기능 (자료비교 정보 추출용)

이겨내자꼭 2025. 12. 9. 16:37

하기봉作.xlam
0.02MB

안녕하세요!
엑셀·한셀·VBA 자동화로 업무 시간을 절반 이상 줄이는 솔루션을 연구하는 아이엠(I AM) 입니다.

평소 반복되는 데이터 처리, 공휴일 자동 입력, 일정 관리, 리본 메뉴 제작 같은
"해보면 복잡하고 설명은 없고… 코드는 오류나는" 문제들을
직접 해결하고 정리하는 블로그를 운영하고 있습니다.

여기서는 다음과 같은 내용을 집중적으로 다룹니다:

  • ✔ 엑셀 VBA 자동화 실전 예제
  • ✔ 리본 메뉴(CustomUI) 제작 및 Add-in 개발
  • ✔ 데이터 일치/불일치 비교 알고리즘
  • ✔ 지수 표시 방지·문자열 비교 최적화 등 팁

“일은 많은데 시간은 부족한 분들”,
“엑셀로 자동화하고 싶은데 어디서부터 시작할지 막막한 분들”에게
정확하고 즉시 적용 가능한 해결책이 되겠습니다.

앞으로도 실무에서 바로 사용할 수 있는 코드와 팁을 꾸준히 공유하겠습니다.
즐겁게 둘러보세요. 환영합니다!

 

Option Explicit

'===============================
' 리본 버튼에서 실행되는 함수
'===============================
Public Sub 일치불일치추출_버튼(control As IRibbonControl)
    Call 일치불일치추출_메인
End Sub


'===============================
' 정규화 함수 (문자열 비교 정확도 강화)
'===============================
Private Function NormalizeKey(v) As String
    Dim s As String
    s = CStr(v)

    ' 1) 앞뒤 공백 제거
    s = Trim$(s)

    ' 2) 특수 공백統一
    s = Replace(s, ChrW(160), " ")     ' 비표준 공백 제거

    ' 3) 숫자처럼 보여도 문자열로 고정 (지수 변환 방지)
    '    긴 숫자는 문자열 그대로 유지
    NormalizeKey = s
End Function


'===============================
' 메인 기능
'===============================
Public Sub 일치불일치추출_메인()

    Dim rng1 As Range, rng2 As Range
    Dim ws As Worksheet
    Dim dictRng2 As Object, seenRng1 As Object
    Dim arrOut() As Variant
    Dim arrR1 As Variant, arrR2 As Variant
    Dim key As String
    Dim colInput As String, colArr As Variant
    Dim i As Long, j As Long
    Dim numRows As Long, numColsOut As Long
    Dim firstCol As Long
    Dim fRow As Long, fCol As Long
    Dim rawValue As Variant

    On Error GoTo ErrHandler

    Set ws = ActiveSheet
    Set dictRng2 = CreateObject("Scripting.Dictionary")
    Set seenRng1 = CreateObject("Scripting.Dictionary")

    '---------------------------------------
    ' 1) 범위 선택
    '---------------------------------------
    Set rng1 = Application.InputBox("첫 번째 비교 범위(기준)를 선택하세요.", "범위 선택", Type:=8)
    If rng1 Is Nothing Then Exit Sub

    Set rng2 = Application.InputBox("두 번째 비교 범위(검색 대상)를 선택하세요.", "범위 선택", Type:=8)
    If rng2 Is Nothing Then Exit Sub

    arrR2 = rng2.Value

    '---------------------------------------
    ' 2) 추출할 열 입력
    '---------------------------------------
    colInput = InputBox("두 번째 범위에서 가져올 열 번호(콤마 구분) 예: 1,4,6", "열 선택")
    If Trim(colInput) = "" Then Exit Sub

    colArr = Split(Replace(colInput, " ", ""), ",")
    numColsOut = UBound(colArr) - LBound(colArr) + 1

    '---------------------------------------
    ' 3) Dictionary로 rng2 index 구축
    '    첫 열 기준
    '---------------------------------------
    For i = 1 To UBound(arrR2, 1)
        rawValue = arrR2(i, 1)

        key = NormalizeKey(rawValue)

        If Len(key) > 0 Then
            If Not dictRng2.Exists(key) Then
                dictRng2.Add key, rng2.Rows(i).Row
            End If
        End If
    Next i

    '---------------------------------------
    ' 4) 출력 배열 준비 (빠르고 오류 없음)
    '---------------------------------------
    arrR1 = rng1.Value
    numRows = rng1.Rows.Count
    ReDim arrOut(1 To numRows, 1 To numColsOut)

    ' 출력 열 = rng1 오른쪽 첫 열
    firstCol = rng1.Columns(rng1.Columns.Count).Column + 1

    '---------------------------------------
    ' 5) 비교 시작
    '---------------------------------------
    For i = 1 To numRows

        rawValue = arrR1(i, 1)
        key = NormalizeKey(rawValue)

        If Len(key) = 0 Then
            ' 빈 값은 그대로 빈칸
            ' (자동 초기화되어 있으므로 별도 처리 필요 없음)

        Else
            If seenRng1.Exists(key) Then

                ' 중복 처리
                arrOut(i, 1) = "중복"

            Else
                seenRng1.Add key, 1

                If dictRng2.Exists(key) Then
                    '========== 일치 ==========
                    fRow = dictRng2(key)

                    ' 가져올 열들 출력
                    For j = 1 To numColsOut
                        fCol = CLng(colArr(LBound(colArr) + j - 1))
                        arrOut(i, j) = ws.Cells(fRow, fCol).Text   ' ← TEXT 로 가져와 지수변환 방지
                    Next j

                Else
                    '========== 불일치 ==========
                    arrOut(i, 1) = "불일치"
                End If

            End If
        End If
    Next i

    '---------------------------------------
    ' 6) 시트에 한 번에 출력 (밀림 방지)
    '---------------------------------------
    ws.Range(ws.Cells(rng1.Row, firstCol), _
             ws.Cells(rng1.Row + numRows - 1, firstCol + numColsOut - 1)).Value = arrOut

    ' 자동 폭
    ws.Columns(firstCol).Resize(, numColsOut).EntireColumn.AutoFit

    MsgBox "완료되었습니다!", vbInformation
    Exit Sub


ErrHandler:
    MsgBox "오류 발생: " & Err.Number & " - " & Err.Description, vbExclamation

End Sub

 

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <tabs>
      <tab idMso="TabHome">
        <group id="grpIM" label="I AM">
          <button id="btnMatch"
                  label="일치·불일치 추출"
                  imageMso="DrawingInsert"
                  size="large"
                  onAction="일치불일치추출_버튼"/>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>