VBA 데이터유효성검사 '목록' 여러개 만들기

VBA 데이터유효성검사 '목록' 여러개 만들기

2020. 5. 28. 17:18ㆍVBA

728x90

<TEMP - Background Data >

위 와같은 데이터가 있다는 가정하에 진행을 합니다.

<결과물>

엑셀의 데이터유효성 검사의 '목록' 을 이용해 유동적으로

대분류를 누르면 대분류에 해당하는 항목이 보여지고,

중분류를 누르면 중분류와 일치 하는 항목을 보여줍니다.

첫 번째 - TEMP 에 사용할 데이터를 만듭니다.

저 같은 경우는 TEMP 라는 시트에 백 데이터를 작성했습니다.

두 번째 - 메인시트에서 분류 눌렀을 때 이벤트 코드를 작성합니다.

* Alt + F11을 눌러 Sheet2에 코드를 작성 합니다.

Sub Worksheet_SelectionChange(ByVal Target As Range)

    ' ** 열이 1열 이고, 행이 4행이고, 선택한 셀의 갯수가 1개일 때만 동작하도록.
    
    ' * 처음 [대분류] 눌렀을 때 [대분류]에 리스트 추가하려고.
    If Target.Column = 1 And Target.Row = 4 And Target.CountLarge = 1 Then
       Call Firstload(Target)
    End If
    
    ' * [대분류] 눌렀을 때 다음 항목 뜨게 하려고.
    If Target.Column = 1 And Target.Row = 4 And Target.CountLarge = 1 Then
      Call whenFirstCombobox(Target)
    ElseIf Target.Column = 2 And Target.Row = 4 And Target.CountLarge = 1 Then
      Call whenSecondCombobox(Target)
    ElseIf Target.Column = 3 And Target.Row = 4 And Target.CountLarge = 1 Then
      'Call whenThirdCombobox(Target)
    End If
  
End Sub

조금 복잡하게 작성했는데, 여 러개의 항목을 사용할 수 있게 작성해서 그런 것 같습니다.

간단하게 시나리오를 짜보자면,

1. [대분류]를 누르면 대분류에 해당하는 리스트가 나와야 한다.

2. [대분류]를 선택 했을 때 [대분류]에 맞는 [중분류]가 나와야 한다.

3. [중분류]를 선택 했을 때 [대분류]와 [중분류]와 일치하는 [소분류]에 리스트가 나와야 한다.

※ 모든 리스트는 중복이 제거 되어야 한다.

▶ 1번 항목

Sub Firstload(ByVal Target As Range)

    ' ** 첫 번째 선택 시 중분류, 소분류 값 지워주기.
    Target.Offset(, 1).Value = ""
    Target.Offset(, 2).Value = ""
    
    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant, rng As Range
    
    ' ** TEMP에 있는 값 범위를 담아 배열에 넣습니다.
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant, strText As String
    
    ' ** 미리 만들어둔 [returnV] 라는 함수로 중복제거 후
    ' ** 제거 된 리스트를 새로운 배열에 담습니다.
    s = returnV(v, 1, Target)
    
    strText = Join(s, ",") ' 배열을 콤마(,) 기준으로 텍스트로 합칩니다.
    
    If (strText <> "") Then
        ' ** 데이터유효성 추가합니다.
        With Target.Validation
        .Delete
        .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub

▶ 2번 항목

Sub whenFirstCombobox(ByVal Target As Range)

    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant, rng As Range
    
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant, strText As String
    
    s = returnV(v, 2, Target)
    strText = Join(s, ",")
    
    Target.Offset(, 1).Value = ""
    
    If (strText <> "") Then
        With Target.Offset(, 1).Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub

▶ 3번 항목

Sub whenSecondCombobox(ByVal Target As Range)

    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant
    Dim rng As Range
    
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant
    Dim strText As String
    
    s = returnV(v, 3, Target)
    
    ' ㅇㅇ,ㅇㅇ,ㅇㅇ,
    strText = Join(s, ",")
    
    If (strText <> "") Then
        With Target.Offset(, 1).Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub

▶▶ ※ 중복을 제거할 함수 코드

' ** 중복 제거 후 배열을 리턴합니다.
Function returnV(ByRef v As Variant, ByRef num As Integer, ByRef Target As Range) As Variant
    Dim vs As Variant: ReDim vs(LBound(v, 1) + 1 To UBound(v, 1))
    
    If num = 1 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            vs(i) = v(i, num)
        Next
    ElseIf num = 2 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 3 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -1) And v(i, 2) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 4 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -2) And v(i, 2) = Target.Offset(, -1) And v(i, 3) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 5 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -3) And v(i, 2) = Target.Offset(, -2) And v(i, 3) = Target.Offset(, -1) And v(i, 4) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 6 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -4) And v(i, 2) = Target.Offset(, -3) And v(i, 3) = Target.Offset(, -2) And v(i, 4) = Target.Offset(, -1) And v(i, 5) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    End If
    
    Dim c As Variant
    Dim nC As New Collection
    For Each c In vs                 ' 배열의 반복
        On Error Resume Next
        nC.Add Item:=c, Key:=CStr(c)  ' Collection 개체로 유니크 한 항목 추가
        On Error GoTo 0
    Next c
    Debug.Print nC(1)
    ReDim v(1 To nC.Count)
    For i = LBound(v) To UBound(v)
        v(i) = nC(i)
    Next i
    returnV = v
    
End Function

최종 - 전체 코드

Sub Worksheet_SelectionChange(ByVal Target As Range)

    ' ** 열이 1열 이고, 행이 4행이고, 선택한 셀의 갯수가 1개일 때만 동작하도록.
    
    ' * 처음 [대분류] 눌렀을 때 [대분류]에 리스트 추가하려고.
    If Target.Column = 1 And Target.Row = 4 And Target.CountLarge = 1 Then
       Call Firstload(Target)
    End If
    
    ' * [대분류] 눌렀을 때 다음 항목 뜨게 하려고.
    If Target.Column = 1 And Target.Row = 4 And Target.CountLarge = 1 Then
      Call whenFirstCombobox(Target)
    ElseIf Target.Column = 2 And Target.Row = 4 And Target.CountLarge = 1 Then
      Call whenSecondCombobox(Target)
    ElseIf Target.Column = 3 And Target.Row = 4 And Target.CountLarge = 1 Then
      'Call whenThirdCombobox(Target)
    End If
  
End Sub


Sub Firstload(ByVal Target As Range)

    ' ** 첫 번째 선택 시 중분류, 소분류 값 지워주기.
    Target.Offset(, 1).Value = ""
    Target.Offset(, 2).Value = ""
    
    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant, rng As Range
    
    ' ** TEMP에 있는 값 범위를 담아 배열에 넣습니다.
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant, strText As String
    
    ' ** 미리 만들어둔 [returnV] 라는 함수로 중복제거 후
    ' ** 제거 된 리스트를 새로운 배열에 담습니다.
    s = returnV(v, 1, Target)
    
    strText = Join(s, ",") ' 배열을 콤마(,) 기준으로 텍스트로 합칩니다.
    
    If (strText <> "") Then
        ' ** 데이터유효성 추가합니다.
        With Target.Validation
        .Delete
        .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub


Sub whenFirstCombobox(ByVal Target As Range)

    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant, rng As Range
    
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant, strText As String
    
    s = returnV(v, 2, Target)
    strText = Join(s, ",")
    
    Target.Offset(, 1).Value = ""
    
    If (strText <> "") Then
        With Target.Offset(, 1).Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub

Sub whenSecondCombobox(ByVal Target As Range)

    Dim ms As Worksheet: Set ms = Workbooks(ThisWorkbook.Name).Sheets("TEMP")
    Dim v As Variant
    Dim rng As Range
    
    Set rng = ms.Range("A1").CurrentRegion
    v = rng
    
    Dim s As Variant
    Dim strText As String
    
    s = returnV(v, 3, Target)
    
    ' ㅇㅇ,ㅇㅇ,ㅇㅇ,
    strText = Join(s, ",")
    
    If (strText <> "") Then
        With Target.Offset(, 1).Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, strText
        End With
    End If
    
    Erase v
    Set rng = Nothing

End Sub


' ** 중복 제거 후 배열을 리턴합니다.
Function returnV(ByRef v As Variant, ByRef num As Integer, ByRef Target As Range) As Variant
    Dim vs As Variant: ReDim vs(LBound(v, 1) + 1 To UBound(v, 1))
    
    If num = 1 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            vs(i) = v(i, num)
        Next
    ElseIf num = 2 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 3 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -1) And v(i, 2) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 4 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -2) And v(i, 2) = Target.Offset(, -1) And v(i, 3) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 5 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -3) And v(i, 2) = Target.Offset(, -2) And v(i, 3) = Target.Offset(, -1) And v(i, 4) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    ElseIf num = 6 Then
        For i = LBound(v, 1) + 1 To UBound(v, 1)
            If v(i, 1) = Target.Offset(, -4) And v(i, 2) = Target.Offset(, -3) And v(i, 3) = Target.Offset(, -2) And v(i, 4) = Target.Offset(, -1) And v(i, 5) = Target Then
                vs(i) = v(i, num)
            End If
        Next
    End If
    
    Dim c As Variant
    Dim nC As New Collection
    For Each c In vs                 ' 배열의 반복
        On Error Resume Next
        nC.Add Item:=c, Key:=CStr(c)  ' Collection 개체로 유니크 한 항목 추가
        On Error GoTo 0
    Next c
    Debug.Print nC(1)
    ReDim v(1 To nC.Count)
    For i = LBound(v) To UBound(v)
        v(i) = nC(i)
    Next i
    returnV = v
    
End Function

728x90

저작자표시

'VBA' 카테고리의 다른 글

VBA 아주 쉽게 PivotTable 생성 후 Pivot Chart 만들고 Slicer를 추가하는 Code (0)	2020.06.18
c# winform) listbox에 item을 add했는데요. 텍스트 크기와 글자체 변경, 그리고 가운데 정렬 어떻게하나요? (0)	2020.05.29
VBA 엑셀에서 프린터 설정화면 띄우기 (0)	2020.05.28
엑셀 vba를 통해 pdf 파일을 열고 싶습니다. (0)	2020.05.28
엑셀 vba 프린터 선택하기 (0)	2020.05.28

악마성의 똑같은 일상!

악마성의 똑같은 일상!

태그

최근글

댓글

공지사항

아카이브

'VBA' 카테고리의 다른 글

관련글

티스토리툴바