[기초방] VBA 100제 #24 [ 멀티 필터링 ]

이번 문제는 본인이 의뢰받은 일중에서 계속적으로 필터링을 해야 하는데 그때마다 필터의 설정 / 해제를 해준는것이 불편하여 사용하고 있던 필터링 문제를 착안하여 문제를 만들어 보았다.

 

역시 사용된 것은 이벤트 구문 + 필터링으로 노력한거에 비해 뽀대(?) 뿜뿜인 녀석이다.

실무에 활용하기 바란다.

 

기초방 구문은 익숙하지가 않아서 그렇지 그 원리를 알면 코드를 이해하거나 활용에 대해서는 각자의 코딩 지식 수준에 따라 그 스펙트럼이 충분히 더 넓어지리라 예상한다.

 

 구문 진행은 이렇다.

 

더블클릭이벤트로 영역안에서 더블 클릭하면 자동 필터가 설정 또는 해제된다.

체인지 이벤트는 이벤트 구간의 값의 변화에 따라 포함 / 일치 / 이상 / 이상 순으로 체인지 이벤트를 설정하였다.

On Error Resume Next
    
        If Target.Column = "3" Then rngAll.AutoFilter 1, "=" & Target & "*", , , 1      
        If Target.Column = "4" Then rngAll.AutoFilter 2, Format(Target, "0.0"), , , 1   
        If Target.Column = "5" Then rngAll.AutoFilter 3, ">=" & Target, , , 1           
        If Target.Column = "6" Then rngAll.AutoFilter 4, ">=" & Target, , , 1           
        
On Error GoTo 0

딱총님과 시훈아빠님이 사용하신 Select Case 를 이용하는 코드도 좋아보여 소개한다.

같은 이름에 대해서 알파벳을 증가시키는 구문은 이렇다.

조건식에 Cnt >1 은 고유값은 그대로 두고 / 다음 중복값부터  엑사남, 엑사남A,  엑사남B 이렇게 표기하기 위해서이다.

If rngX = rngA Then  
               
    Cnt = Cnt + 1  

    If Cnt > 1 Then rngA = rngA & Chr(63 + Cnt)

End If

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim rngAll As Range: Set rngAll = Range([c12], [c12].End(2).End(4))             '= 전체 영역
                
        rngAll.AutoFilter                                                           '= 자동 필터의 설정 / 해제
        
        Cancel = True
        
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngAll As Range

    If Intersect(Target, [c11:f11]) Is Nothing Then Exit Sub                       '= 이벤트 영역
    
    With Sheets("필터")
           
           Set rngAll = Range(.[c12], .[f12].End(4))                               '= 필터링 될 영역
            
    End With
    
    On Error Resume Next
    
        If Target.Column = "3" Then rngAll.AutoFilter 1, "=" & Target & "*", , , 1      '= 이름의 일부가 포함된 모든 이름 필터링
        If Target.Column = "4" Then rngAll.AutoFilter 2, Format(Target, "0.0"), , , 1   '= 가중치가 일치된 필터링
        If Target.Column = "5" Then rngAll.AutoFilter 3, ">=" & Target, , , 1           '= 점수가 선택된 이상인 필터링
        If Target.Column = "6" Then rngAll.AutoFilter 4, ">=" & Target, , , 1           '= 총점이 선택된 이상인 필터링
        
    On Error GoTo 0
End Sub

Sub 기초방24()

    Dim rngAll As Range: Set rngAll = Range([c12], [c12].End(2).End(4))
    Dim rngA As Range
    Dim rngX As Range: Set rngX = [c13]
    Dim Cnt&
    
    Do Until IsEmpty(rngX)                                                          '= 이름 영역을 순환
    
        For Each rngA In rngAll.Columns(1).Cells                                    '= 각 이름을 순환
        
            If rngX = rngA Then                                                     '= 기준 이름과 순환된 이름이 같다면
               
                Cnt = Cnt + 1                                                       '= Cnt를 +1 해라 / 이름 중복 체크
                                                                                    
                If Cnt > 1 Then rngA = rngA & Chr(63 + Cnt)                         '= 첫번째는 고유이름이므로 2번째부터 알파벳을 증가시켜라
                
            End If
            
        Next rngA
    
        Cnt = 0                                                                     '= 중복 카운터 초기화
        
        Set rngX = rngX.Offset(1)
        
    Loop
    
End Sub

오늘더 더 나아진 우리를 위해 화이팅

 

기초방23 (2).xlsm

2.54MB