여러 조건을 만족하는 자료 추출하기

Step 1: 유저폼에 컨트롤 그리기

(1) VB Editor 상태에서 유저폼을 하나 삽입하고 아래와 같이 필요한 컨트롤들을 그려 넣습니다. 두 가지 조건을 받기 위해 두 개의 콤보박스를 사용합니다.

아이엑셀러

Step 2: Activate 이벤트에서 콤보박스 채우기

(2) 유저폼의 빈 공간을 더블클릭하고 우측 상단의 이벤트 선택 목록상자에서

아이엑셀러

Activate 이벤트를 선택하고 아래의 코드를 작성합니다.

Private Sub UserForm_Activate()
    Dim rngCell As Range
    Dim rngFirst As Range
    Dim rngSecond As Range
    Dim sht As Worksheet
    Dim X As New Collection
    Dim Y As New Collection
    Dim varItem As Variant
    Dim varItem2 As Variant
    On Error Resume Next
    '//변수를 선언해 줍니다. 이번 시간에는 다른 강좌에 비해 좀 많은 수의 변수를 선언해
    '//주었습니다. 또한 Dim X As New Collection 이라고 한 것으로 보아 컬렉션 오브젝트를
    '//사용하려나 봅니다. ^^

    '//컬렉션 오브젝트란 말을 처음 들으시나요? 아니지요? 아주 오래 전에 여러 번 설명을
    '//드렸는데 무슨 작업을 할 때 였는지 기억이 나시는지… "중복 아이템"을 추려낼 때
    '//사용했었습니다. 기억이 안 나거나 가물가물하신 분들은 VB0029, 30 강좌를 다시 한번
    '//살펴보시기 바랍니다. 어차피 이번 시간에는 컬렉션 오브젝트를 아셔야 진도를 계속
    '//나갈 수 있으니까요.

    '//그리고 반드시 On Error Resume Next 구문을 넣어주어야 에러가 발생하지 않습니다.

    Set sht = Sheets("WorkPlace")
    Set rngFirst = sht.Columns(1).SpecialCells(xlTextValues)
    Set rngSecond = sht.Columns(2).SpecialCells(xlTextValues)
    '//WorkPlace 시트의 1열과 2열 중 값이 들어있는 모든 셀을 rngFirst, rngSecond 변수에
    '//담아두고…

    For Each rngCell In rngFirst
        X.Add rngCell.Value, CStr(rngCell.Value)
        '//여기서 컬렉션 오브젝트가 사용되었습니다. 컬렉션 오브젝트는
        '//object.Add item, key, before, after
        '//여기서 key argument가 사용되면 반복되는 값이 나타날 경우 error를 발생시키게
        '//됩니다. 그런데 위에서 On Error Resume Next라는 구문을 넣어 주었으므로 계속
        '//작업을 진행하게 되는 것이지요. 즉 의도적인 에러 발생이라고 할 수 있습니다.

    Next rngCell
    For Each varItem In X
        If varItem <> "품목" Then Me.cmbCriteria1.AddItem varItem
        '//위에서 추가된 컬렉션 오브젝트를 AddItem 속성을 통해 콤보박스의 아이템으로
        '//추가해 줍니다.
    Next varItem

    '//아래는 두번째 콤보박스의 내용을 중복되지 않는 브랜드명으로 채워넣기 위한 것으로
    '//위에서 설명드린 것과 같은 내용입니다.
    For Each rngCell In rngSecond
        Y.Add rngCell.Value, CStr(rngCell.Value)
    Next rngCell
    For Each varItem2 In Y
        If varItem2 <> "브랜드" Then Me.cmbCriteria2.AddItem varItem2
    Next varItem2
End Sub

Step 3: OK 버튼에서 두 조건으로 자료 추출하기

(3) Shift + <F7>키를 눌러 유저폼을 다시 호출하고, OK 버튼을 더블클릭하여 Click 이벤트를 발생시킨 다음, 아래와 같은 코드를 작성합니다.

Private Sub btnOK_Click()
    Dim strCriteria1 As String
    Dim strCriteria2 As String
    Dim Msg As String
    Dim rngTarget As Range
    Dim rngCell As Range
    Dim sht As Worksheet
    Dim r As Long
    Application.DisplayAlerts = False

    For Each sht In ThisWorkbook.Sheets
        If sht.Name = "ExtractData" Then sht.Delete
    Next sht
    '//현재 워크북 파일 중에서 "ExtractData"라는 시트가 있을 경우 삭제합니다.
    '//Application.DisplayAlerts=False로 하여 시트를 삭제할 때 "… 지울까요?"하는
    '//메시지를 나타나지 않게 설정합니다.

    Set rngTarget = Sheets("WorkPlace").Columns(1).SpecialCells(xlTextValues)
    strCriteria1 = Me.cmbCriteria1.Value
    strCriteria2 = Me.cmbCriteria2.Value
    '//두 콤보박스로부터 선택된 항목의 값을 strCriteria1과 strCriteria2라는 문자열 변수에
    '//담아둡니다.

    Worksheets.Add after:=Sheets("WorkPlace")
    ActiveSheet.Name = "ExtractData"
    Set sht = Worksheets("ExtractData")
    '//워크시트를 하나 삽입하고 "ExtractData"라고 이름을 정해 줍니다.

    For Each rngCell In rngTarget
        If rngCell.Value = strCriteria1 And rngCell.Offset(0, 1) = strCriteria2 Then
            '//바로 이 부분이 핵심입니다. 첫번째 콤보박스에서 선택된 목록과 rngCell의 값,
            '//그리고 두번째 콤보박스의 목록과 rngCell에서 오른쪽으로 한 간 이동한 셀의
            '//값이 서로 같은지를 비교합니다. 그래서 같은 경우에만 행 전체를 복사해서
            '//ExtractData 시트에 붙여 넣습니다.
            '//만약 세 가지, 네 가지 또는 그 이상의 조건을 비교하려면 이 부분에 And를
            '//사용해서 조건을 추가해 주시면 되겠지요?

            rngCell.EntireRow.Copy
            Application.Goto sht.Range("a1"), True
            Range("a1").Offset(r, 0).Select
            ActiveSheet.Paste
            r = r + 1
        End If
    Next rngCell

    '//작업이 다 끝난 다음에 서식을 꾸미는 과정입니다.
    Rows(1).EntireRow.Insert
    Range("a1") = "품목"
    Range("b1") = "브랜드"
    Range("c1") = "수량"
    Range("d1") = "단가"
    Range("e1") = "금액"
    Range("a1").Select
    Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True, Font:= _
        True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
    Unload Me
    If r < 1 Then
        Msg = "지정하신 조건에 해당되는 자료가 없습니다." & vbCr
        Msg = Msg & "조건을 다시 확인하세요!"
    Else
        Msg = "총 " & r & " 건의 자료가 추출되었습니다"
    End If
    Application.DisplayAlerts = True
    MsgBox Msg, , "자료 추출 완료//Exceller"
End Sub

마무리

다음 시간에 또…

정리 — 다중 조건 추출 핵심

자주 묻는 질문 (FAQ)

마치며

한 가지 조건 추출을 이해했다면 And로 조건을 늘리는 것만으로 여러 조건 추출도 어렵지 않습니다.