이중유효성목록을 선택하여 차트생성하기

엑셀 카페 질문게시판에 올라온 글.

유효성목록에서 항목을 선택하면 차트가 생성됐으면 한다는 질문.

함수를 이용한 답변이 올라왔지만,

매크로로 만들어보았다.

B2 셀을 누르면 분류를 기준으로 유효성목록이 생성되면서 기존에 있던 차트가 없어지고

B3 셀에서 목록을 선택하면 해당 분류의 차트가 생성된다.

분류에 따른 연도 선택은 이중유효성 목록으로 만들었다.

데이터를 추가하거나 분류 자체를 추가하는 것도 가능하다.

Option Explicit
 
Sub mkList()
    
    Dim rngStart As Range
    Dim vrList() As Variant, jnList As String
    Dim rngCell As Range, rngArea As Range
    Dim i As Integer, cntLi As Integer
    Dim rngList As Range, rngYaer As Range
    
    '처리속도 향상
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    '기존 차트 삭제 및 차트생성 위치 설정
    On Error Resume Next
        ActiveSheet.ChartObjects.Delete
    On Error GoTo 0
    
    '유효성검사 및 분류 셀 지정
    Set rngList = Range("B3")
    Set rngStart = Range("B7")
    Set rngArea = Range(rngStart, Cells(Rows.Count, "B").End(xlUp))
    
    rngList = rngStart
    
    For Each rngCell In rngArea
        If Len(rngCell) Then
        
            '연도별 이름관리자 설정
            cntLi = rngCell.MergeArea.Rows.Count
            rngCell.Offset(, 1).Resize(cntLi).Select
            ActiveWorkbook.Names.Add Name:=rngCell, RefersToR1C1:=Selection
            
            '연도를 이중유효성검사로 만들기
            With rngList.Offset(, 1).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Indirect(B3)"
                .IgnoreBlank = True
                .InCellDropdown = True
                .ShowInput = True
                .ShowError = True
            End With
            
            '분류를 돌며 목록을 배열에 넣음
            ReDim Preserve vrList(i)
            vrList(i) = rngCell
            i = i + 1
        End If
    Next rngCell
    jnList = Join(vrList, ",")
    ReDim vrList(0)
    
    '분류를 유효성검사로 만들기
    With rngList.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=jnList
    End With
    
    '월을 유효성검사로 만들기
    With rngList.Offset(, 2).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=D6:O6"
    End With
    
    rngList.Resize(, 3).ClearContents
    rngList.Select
    
    '처리속도 복구
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
        
End Sub
 
Sub mkChart()
 
    Dim rngArea As Range
    Dim rngList As Range, rngFind As Range
    Dim i As Integer
    Dim chtPos As Range
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    '기존 차트 삭제 및 차트생성 위치 설정
    On Error Resume Next
        ActiveSheet.ChartObjects.Delete
    On Error GoTo 0
    
    Set chtPos = Range("P7:W27")
    Set rngList = Range("B3")
    Set rngArea = Range("B6", Cells(Rows.Count, "B").End(xlUp).Offset(1))
    Set rngFind = rngArea.Find(what:=rngList, lookat:=xlWhole)
    i = rngFind.MergeArea.Rows.Count
    
    ActiveSheet.Shapes.AddChart.Select
    
    '차트 서식 지정
    With ActiveChart
        .SetSourceData Source:=rngFind.Resize(i, 14)
        .ChartType = xlLine
        .PlotBy = xlRows
        .SetElement (msoElementLegendTop)
        .SetElement (msoElementPrimaryValueGridLinesNone)
        .HasLegend = True
    
    '차트 위치 지정
        With .Parent
            .Left = chtPos.Left
            .Top = chtPos.Top
            .Width = chtPos.Width
            .Height = chtPos.Height
        End With
    End With
    
    rngList.Select
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub
 
Function fnCount(strList As String, strYear As String, strMonth As String) As Long
 
    Dim rngArea As Range, rngYear As Range
    Dim rngFind As Range
    Dim intR As Integer, intC As Integer
    Dim cntR As Integer
    
    Set rngArea = Range("B6", Cells(Rows.Count, "B").End(xlUp).Offset(1))   '분류 영역
    Set rngFind = rngArea.Find(what:=strList, lookat:=xlWhole)  'B3과 일치하는 분류셀
    Set rngYear = Range("D6:O6")    '월 영역
    
    cntR = rngFind.MergeArea.Rows.Count '분류 열 개수
    intR = rngFind.Offset(, 1).Resize(cntR).Find(what:=strYear, lookat:=xlWhole).Row    '분류 내 연도 열
    intC = rngYear.Find(what:=strMonth, lookat:=xlWhole).Column '분류 내 연도 행
    
    fnCount = Cells(intR, intC)
    
End Function

통합문서.xlsm