한국지도 카토그램 엑셀버전

https://pinkwink.kr/1005

카토그램(영어: cartogram)은 의석수나 선거인단수, 인구 등의 특정한 데이터 값의 변화에 따라 지도의 면적이 왜곡되는 그림을 말한다. 변량비례도(變量比例圖), 왜상 통계 지도(歪像統計地圖)라고도 한다. 위키백과:카토그램

지도 우 상단에 있는 '도움말' 버튼을 누르면 다음의 설명이 나옵니다.

EXECUTION 부분은 실행 버튼입니다.

• INITIAL : 아래 Config 부분의 CELLS와 BORDER 부분을 서식으로 하여 지도를 초기화 하는 버튼입니다.
• MAKE CHART : 테이블의 color_idx 부분과 Config 부분의 Color INDEX 부분을 참고하여 색을 칠하는 버튼입니다.

Config 부분은 여러가지 서식을 지정하는 부분입니다.

• CELLS : 기본 셀 서식을 지정합니다. 이 부분을 서식복사하여 지도를 초기화합니다.
• BORDER : 시도경계 선 양식을 지정합니다. 시도경계에 이 부분의 선 굵기, 색을 사용합니다.
• Color INDEX : 테이블 value 컬럼의 값을 기준으로 Condition 별로 색을 지정합니다. 엑셀의 countif 함수에 적용되는 조건식을 사용할 수 있습니다.

테이블 부분에서 value-comment 까지는(노란색 표시) 지도의 각 셀에 적용되는 부분입니다.

• value : color INDEX config와 연관되는 값을 채우면 됩니다.
• fill : 각 셀에 어떤 글자를 넣을 것인지 채우면 됩니다.
• comment : 각 셀에 마우스 커서를 올렸을 때 보일 문구를 채우면 됩니다.

파일 내 [box_maker Module] 확인

1) 먼저 옆에 그림을 놓고 똑같이 값을 입력합니다.
2) 아래 매크로를 실행하면 값이 입력된 부분만 row와 column 번호 및 셀 값을 테이블 형식으로 저장합니다.

'' 지도에 값 입력한 후 값 있는 곳만 Table에 입력
'' row, col에 있는 번호 입력
Sub fill_table()
    Set outcell = Range("w3")
 
    For Each cell In Selection
        If cell.value <> "" Then
            outcell.value = Cells(cell.Row, 2).value
            outcell.Offset(0, 1).value = Cells(2, cell.Column).value
            outcell.Offset(0, 2).value = cell.value
            Set outcell = outcell.Offset(1, 0)
        End If
    Next cell
End Sub

3) 테이블에서 입력된 row, column 번호에 따라서 아래와 같이 엑셀 함수로 주소를 구해줍니다.
(W3 : row 번호, X3 : column번호, D3 : 지도 시작 셀 주소)

=ADDRESS(W3+ROW($D$3)-1,X3+COLUMN($D$3)-1)

4) 이제 지도를 보고 다시 똑같이 시도 경계를 그려줍니다. 이 때 가장 두꺼운 선 두께로 그리도록 합시다.
그리고 아래 코드를 실행시키면, 셀 별로 선의 두께를 확인한 후 left-right-top-bottom 중 어디에 경계 선을 그리면 될지, 테이블에 값을 입력합니다.

'지도 도광역 경계 찾아서, left-bottom 컬럼에 1 추가해주기
Sub fill_table_line()    
    Set outcell = Range("aa3")
 
    For Each cell In Selection
        If cell.value <> "" Then
            MsgBox cell.Borders(xlEdgeLeft).Weight
            If cell.Borders(xlEdgeLeft).Weight = xlThick Then
                outcell.Offset(0, 0).value = 1
            ElseIf cell.Borders(xlEdgeRight).Weight = xlThick Then
                outcell.Offset(0, 1).value = 1
            ElseIf cell.Borders(xlEdgeTop).Weight = xlThick Then
                outcell.Offset(0, 2).value = 1
            ElseIf cell.Borders(xlEdgeBottom).Weight = xlThick Then
                outcell.Offset(0, 3).value = 1
            End If
 
            Set outcell = outcell.Offset(1, 0)
        End If
    Next cell
End Sub

5) 테이블에 기타 필요한 컬럼 (셀 색, 기준 값, 셀에 들어갈 문구 등..)을 만들어 테이블을 완성합니다. (W:AJ 영역)
color_idx 에서는 value 값을 참고해서 Config 내의 Color INDEX 테이블 내의 색 번호를 가져와야 합니다. 아래와 같이 엑셀의 countif함수를 응용하여 함수를 만들어 사용했습니다.
VS_COLOR : Color INDEX 테이블 범위(이름정의)

=color_idx(VS_COLOR,AH3)  //AH3 : value  컬럼

Function color_idx(ref As Range, value As Range)
    i = 1
    For Each cell In ref
        If Application.CountIf(value, cell.value) = 1 Then
            color_idx = i
            Exit For
        End If
        i = i + 1
    Next cell
End Function

파일 내 [box_util Module] 확인

※ 참고 : get_col_index 는 테이블 내에서 컬럼명을 찾아서 몇번째 있는지 리턴해 주는 함수입니다.(아래 설명에서는 생략)

1) 지도 초기화 하기
먼저 VS_TABLE 내에서 address 컬럼을 찾아서, 그 주소에 있는 셀에 VS_CELL을 서식 복사하는 내용입니다.
이름 정의는 아래와 같습니다.
VS_TABLE : 지도 정보 저장하는 테이블 영역(이름정의, W:AJ 컬럼)
VS_CELL : 지도의 기본 셀 서식을 지정하는 셀(이름정의, U11)

Sub draw_box()
    Set tbl = Range("VS_TABLE")
    Set tpl = Range("VS_CELL")
    tpl.Copy
    idx = 1
    For Each r In tbl.Rows
        If idx = 1 Then
            col = get_col_index(r, "address")
            col2 = get_col_index(r, "fill")
            idx = idx + 1
            GoTo NextIteration
        End If
        Set cell = Range(r.Cells(1, col).value)
 
        cell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                  SkipBlanks:=False, Transpose:=False
        cell.Validation.Delete
        cell.value = r.Cells(1, col2).value
 
NextIteration:
    Next r
End Sub

그 다음 left-bottom 컬럼에서 시도 경계를 찾아서 시도 경계 선을 그려주는 스크립트입니다.

VS_BORDER : 시도 경계의 선 스타일을 지정하는 셀(이름정의, U13)

Sub draw_line_box()
    Set tbl = Range("VS_TABLE")
 
    edges = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)
    idx = 1
    For Each r In tbl.Rows
        If idx = 1 Then
            col = get_col_index(r, "left")
            cols = get_col_index(r, "address")
            idx = idx + 1
        End If
        For idx = 0 To 3
            Set tpl = Range("VS_BORDER").Borders(edges(idx))
            If r.Cells(1, col + idx) = 1 Then
                Set cell = Range(r.Cells(1, cols).value)
                With cell.Borders(edges(idx))
                    .LineStyle = tpl.LineStyle
                    .Weight = tpl.Weight
                    .LineStyle = tpl.LineStyle
                    .Color = tpl.Color
                End With
            End If
        Next idx
    Next r
End Sub

2) 지도 색칠하기
테이블 내에 color_index 컬럼에 있는 번호를 색 옵션 테이블에서 찾아서 셀을 색칠해 주는 부분입니다.
VS_COLOR : 테이블의 color_index 컬럼에 있는 번호별 셀 색을 지정해 놓은 테이블(이름정의, U17:U21)

Sub fill_color()
    Set tbl = Range("VS_TABLE")
    Set tpl = Range("VS_COLOR")
    idx = 1
    For Each r In tbl.Rows
        If idx = 1 Then
            col = get_col_index(r, "address")
            col2 = get_col_index(r, "color_idx")
            idx = idx + 1
        Else
            Set cell = Range(r.Cells(1, col).value)
            cell.Interior.Color = tpl.Cells(r.Cells(1, col2).value, 1).Interior.Color
            cell.Font.Color = tpl.Cells(r.Cells(1, col2).value, 1).Font.Color
 
        End If
    Next r
End Sub

3) 툴팁Tooltip 지정하기
처음에는 엑셀의 메모 기능을 이용하려 했으나, 메모 기능을 사용하면 셀 우측 코너에 삼각형 모양이 생겨서 지도의 가독성이 떨어지는 문제가 있습니다.
그래서 유효성 검사를 사용했을 때 나오는 부분을 툴팁으로 이용하기로 했습니다.

Sub add_comment()
 
    Set tbl = Range("VS_TABLE")
    idx = 1
    For Each r In tbl.Rows
        If idx = 1 Then
            col = get_col_index(r, "address")
            col2 = get_col_index(r, "comment")
            idx = idx + 1
            GoTo Nextiter
        End If
 
        Set cell = Range(r.Cells(1, col).value)     
 
        With cell.Validation
            .Delete
            .add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
            :=xlBetween
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "   "
            .ErrorTitle = ""
            .InputMessage = r.Cells(1, col2).value
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
Nextiter:
    Next r
 
End Sub