[VBA] 고급필터를 이용한 옵션선택

본인이 고급필터를 처음 알았을 때 당시에는 Vlookup을 남발하던 시기였던걸로 기억한다.

아무것도 모른채 접한 고급필터는 정말 신세계였던 걸로 기억한다.

 

고급필터의 단점은 단발성이기 때문에 VBA와의 조합으로 연속적이며 가변적인 움직임을 줄 수 있다.

이번 구문은 이렇다 품목에서 제품에 맞는 각 옵션들을 불러와서

더블 클릭으로 선택한 아이템들이 해당 제품들의 각 위치에 정확히 들어가는 구문이다.

코드는 어렵지 않지만 생각보다 뽀대(?) 나는 작업임을 확신한다.

 

 

코드가 너무 쉽고 간단해서 코드 설명은 피하도록 하겠다.

 

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim rngD As Range
    Dim rngE As Range
    Dim rngf As Range
    Dim rngX As Range
    Dim R&
    
    If [C18] <> "" Then Set rngD = Range([C18], Cells(Rows.Count, "C").End(3))
    If [D18] <> "" Then Set rngE = Range([D18], Cells(Rows.Count, "D").End(3))
    If [E18] <> "" Then Set rngf = Range([E18], Cells(Rows.Count, "E").End(3))
    
    
    If Not Intersect(rngD, Target) Is Nothing Then
        
        Set rngX = [b4:b12].Find(what:=[b15], lookat:=xlWhole)
        Cells(rngX.Row, Target.Column) = Target
    
    End If
    
    If Not Intersect(rngE, Target) Is Nothing Then
        
        Set rngX = [b4:b12].Find(what:=[b15], lookat:=xlWhole)
        Cells(rngX.Row, Target.Column) = Target
    
    End If
    
    If [E18] <> "" Then
    
        If Not Intersect(rngf, Target) Is Nothing Then
            
            Set rngX = [b4:b12].Find(what:=[b15], lookat:=xlWhole)
            Cells(rngX.Row, Target.Column) = Target
        
        End If
    End If
        
    Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDAta As Range
    Dim rngCri As Range
    Dim rngX As Range
    
    If Intersect([b15], Target) Is Nothing Then Exit Sub
    
    With [b17].CurrentRegion.Offset(1)
    
        .Borders.LineStyle = xlNone
        .ClearContents
    
    End With
    
    Set rngDAta = Sheets("품목").[a1].CurrentRegion
    Set rngCri = Sheets("예약").[b14:b15]
    Set rngX = [b17:C17]
   
   '= 고급필터 구간
    rngDAta.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=rngCri, _
            CopyToRange:=rngX, _
            Unique:=False

    Set rngDAta = Sheets("품목").[D1].CurrentRegion
  
    Set rngX = [D17]
     
    rngDAta.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=rngCri, _
            CopyToRange:=rngX, _
            Unique:=False
    Set rngDAta = Sheets("품목").[G1].CurrentRegion
    Set rngX = [E17]
      
    rngDAta.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=rngCri, _
            CopyToRange:=rngX, _
            Unique:=False
            [d18:f40].Font.Size = 8
            
End Sub

고급필터.xlsm

0.02MB