반응형
이 페이지에서는 웹에서 다운로드한 원시 코로나 데이터 파일을 이용해서, 유용한 데이터로 가공하는 엑셀 매크로 프로그램에 대해서 설명합니다.
모두 8 단계의 단계를 거치면 원하는 데이터로 가공되게 했습니다.
이처럼 단계를 나누고 단계별로 다른 프로시저로 구성하는 것이 엑셀 VBA 프로그래밍에서 매우 중요합니다. 그래야 코드가 깔끔해지고 디버깅이 쉽습니다.
메인 프로시저로 ConvertSourceData를 만들었습니다. 여기서 각 단계별로 해당 프로시저들을 호출합니다.
Sub ConvertSourceData()
Dim wb As Workbook
Dim src_sheet As Worksheet, tgt_sheet As Worksheet
Dim prg_sheet As Worksheet
Dim src_file_name As String, src_sheet_name
Set prg_sheet = Workbooks("program.xlsm").Sheets("program")
src_file_name = prg_sheet.Cells(12, 12).Value
src_sheet_name = prg_sheet.Cells(13, 12).Value
Set wb = Workbooks(src_file_name)
Set src_sheet = wb.Sheets(src_sheet_name)
'1. Create target sheet as "data"
src_sheet.Activate
Sheets.Add.Name = "data"
Set tgt_sheet = Sheets("data")
'2. Get unique date and countries
Dim dates As Variant, countries As Variant
dates = GetUniqueData(src_sheet, 1)
countries = GetUniqueData(src_sheet, 7)
'3. make format
Call MakeFormat(tgt_sheet, dates, countries)
'4 create dictionary for cases and deaths
Dim cases_deaths As Object
Set cases_deaths = CreateObject("Scripting.Dictionary")
Call MakeCasesDict(cases_deaths, src_sheet)
'5 write case and death value
Call WriteCaseDeath(tgt_sheet, cases_deaths)
'6. Calculate Cumulated data
Call CalculateCumul(tgt_sheet)
'7. Calculate rank
Call CalculateRank(tgt_sheet)
'8. Create rank sheet
src_sheet.Activate
Sheets.Add.Name = "rank"
Dim rank_sheet As Worksheet
Set rank_sheet = Sheets("rank")
Call RankCountryByCumulData(tgt_sheet, rank_sheet)
End Sub
소스코드 전체에 대해서 하나하나 설명하진 않고 핵심 되는 부분만 설명하겠습니다.
전체 소스코드는 이 글의 하단부에 기재할 것이고, 프로그램 코드가 들어 있는 엑셀 파일도 첨부해놨습니다.
소스파일 이름 및 시트명 입력받는 기법
가변 되는 데이터를 어떻게 입력받을 것인가는 항상 고민되는 항목입니다.
웹에서 다운로드한 데이터 파일명을 알아야, 그 파일에서 데이터를 가지고 올 텐데, 사용자마다 다운로드한 폴더 및 파일명이 다르기에, 사용자가 값을 바꿔줘야 합니다.
가장 간단한 방법은 프로그램 코드 내에서 상수로 값을 넣어두고, 사용자가 그 값을 직접 바꾼 후 프로그램을 실행하게 하는 것.
그러나 이 방법은 프로그램 코드를 사용자가 직접 손을 대야 하기에, 별롭니다.
제가 가장 많이 사용하는 방법이, 엑셀 시트에 사용자가 입력할 수 있는 셀을 만들어 두고, 사용자가 그 셀의 내용을 바꾼 후 실행 버튼을 누르게 하는 것.
엑셀 데이터에서 고유한 값만 추려내기
다운로드한 코로나 데이터를 보면 한 행에 하나씩 날자/국가/신규 감염자/신규 사망자 데이터가 있습니다.
여기서 날자 데이터에 대해서 중복된 항목을 제거해서 유니크한 날자 집합만 얻어내야 하고, 또한 국가도 유니크한 국가 리스트를 얻어내야 합니다. --> GetUniqueData 함수를 만듦
엑셀 기능을 사용한다면 쉽습니다. 엑셀 기능에 '중복된 항목 제거'란게 있어서, 선택된 영역에 있는 데이터에서 중복된 항목을 쉽게 제거할 수 있습니다.
근데 VBA에서는 중복된 항목을 제거하는 것이 꽤나 까다로운 문제입니다.
물론, 해당 데이터를 임시 시트에 카피하고, VBA에서 그 영역을 선택하고 엑셀의 worksheet 함수를 호출해서 고윳값만 남게 해서 사용할 수도 있습니다.
VBA에서 이것을 쉽게 할 수 있는 방법을 찾았습니다. Dictionary를 이용한 꼼수입니다. ^^
For r = 1 To UBound(data)
dict(data(r, 1)) = Empty
Next r
data = dict.keys
위에서 data는 해당 영역의 값을 배열로 읽어 들인 값이고, 이 배열에 있는 모든 것을 딕셔너리에 key 항목으로 모두 꾸겨넣고, 딕셔너리의 키 값만 읽어내면 되는 것입니다.
딕셔너리의 특성상 키 데이터는 유일해야 하기에, 중복된 항목들을 집어넣으면 딕셔너리 내부에서 알아서 중복된 것들은 없애주게 됩니다.
위에서 data(r,1)처럼 한 것은, 엑셀 시트의 column 데이터를 배열로 읽었기 때문에, 데이터가 2차원 배열이 되었기 때문입니다.
정렬 함수
엑셀 VBA에는 정렬 함수가 없습니다.!!!
해서 저는 퀵 소트를 구현해놓고 필요할 때마다 쓰고 있습니다. --> program 파일의 Common 모듈 내 있음
'usage: QuickSort(arr,LBound(arr), UBound(arr))
Sub QuickSort(ByRef arr As Variant, Lo As Long, Hi As Long)
Dim varPivot As Variant, varTmp As Variant
Dim tmpLow As Long, tmpHi As Long
tmpLow = Lo
tmpHi = Hi
varPivot = arr((Lo + Hi) / 2)
Do While tmpLow <= tmpHi
Do While arr(tmpLow) < varPivot And tmpLow < Hi
tmpLow = tmpLow + 1
Loop
Do While varPivot < arr(tmpHi) And tmpHi > Lo
tmpHi = tmpHi - 1
Loop
If tmpLow <= tmpHi Then
varTmp = arr(tmpLow)
arr(tmpLow) = arr(tmpHi)
arr(tmpHi) = varTmp
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Loop
If Lo < tmpHi Then QuickSort arr, Lo, tmpHi
If tmpLow < Hi Then QuickSort arr, tmpLow, Hi
End Sub
실행 속도 빠르게 하기
엑셀 VBA 프로그래밍을 하는 개발자들의 공통적인 얘기가 속도가 느리다는 것일 겁니다.
그런데, 몇 가지 기법을 쓰면, 꽤 쓸만한 속도를 낼 수 있습니다. 심지어 이 기법을 쓰지 않으면 10분 정도 걸리는 작업을 몇 초안에 할 수 있습니다.
이러한 기법을 안 쓰면, 데이터 크기가 만 개 이상만 되어도, 그 데이터들을 엑셀 시트에 읽고 쓰고 하는 작업이 몇십 초 혹은 몇 분 걸립니다. 그래서 느려서 못쓰겠다 하는데, 여기서 소개하는 기법을 적용하면 극적으로 빨라질 것입니다.
기법 1. 셀(cell) 쓰기 횟수를 최대한 줄인다.
for나 while루프를 이용해서 row를 1에서 10000까지 증가시키면서 뭔가 쓴다.
이렇게 하면 안 됩니다. 쓸 내용을 배열에다 집어넣고, row 1~10000까지를 Range로 만든 후, 배열 값을 Range에 한 번에 넣어야 합니다.
엑셀 VBA에서 가장 많이 시간을 잡아먹는 것이 cell 쓰기 작업이기 때문입니다.
여기서 소개하는 program.xlsm에서도, 대부분의 값을 배열로 다 처리하고 난 후 그 값을 엑셀 시트에 한 번에 쓰기 하고 있습니다.
1000개의 셀에 하나씩 쓰기 작업하면 약 20초 소요. 이걸 배열 처리해서 한 번에 쓰면 약 0.2초
기법 2. 엑셀의 속도 관련 속성 값을 조절
program.xlsm 코드 안에 보면 SetTurbo 프로시저를 찾을 수 있을 겁니다.
Sub SetTurbo(is_on As Boolean)
If is_on Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual '매크로 속도를 엄청 빠르게 만듬
Else
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
SetTurbo(True)로 하면 Applicaton관련 3개의 속성값이 바뀝니다. 전부 수행 속도에 영향을 미치는 것으로, 특히 대규모의 데이터를 다룰때는 Application.Calculaton=xlCalculationManual이 수행 속도 절감에 큰 영향을 끼집니다.
이 SetTurbo 함수를, for나 while루프 들어가기 전에 True로 하고, 루프를 빠져 나왔을 때 False해주면 되는데, 이 함수만 사용해줘도 엄청난 속도 향상을 보일 수 있을 것입니다.
데이터의 크기 순위(rank) 알아내기
program.xlsm의 코드 중에 CalculateRank 프로시저에서, 누적 감염자 순에 따라 각 날자별 국가 순위를 계산합니다.
엑셀 데이터에서 순위를 알아내는 것은 WorksheetFunction.Rank_Eq를 쓰면 간단합니다.
해서, 별도로 순위를 뽑아내는 VBA 코드를 만들까 하다가, 그냥 엑셀 워크시트 함수를 사용했습니다.
문제는 워크시트 함수의 경우 그 입력값이 Range라야한다는 것. 그래서 해당 데이터를 뽑아낸 후 다시 그 데이터를 시트의 특정 영역에다가 쓰고, 그 영역을 Range로 잡아서 Rank_Eq에 넘겨주는 형태로 처리했습니다.
'CalculateRank 프로시저 내부
For r = sr To er
k = 0
For c = 3 To ec Step 6
buff_case(k) = Cells(r, c).Value
buff_death(k) = Cells(r, c + 3).Value
k = k + 1
Next c
Set rng_case = Range(Cells(r, ec + 1), Cells(r, ec + 1 + country_cnt - 1))
Set rng_death = Range(Cells(r + 1, ec + 1), Cells(r + 1, ec + 1 + country_cnt - 1))
rng_case.Value = buff_case
rng_death.Value = buff_death
For c = 3 To ec Step 6
tgt_val = Cells(r, c).Value 'case_cumul
Cells(r, c + 1).Value = WorksheetFunction.Rank_Eq(tgt_val, rng_case, 0)
tgt_val = Cells(r, c + 3).Value 'death_cumul
Cells(r, c + 4).Value = WorksheetFunction.Rank_Eq(tgt_val, rng_death, 0)
Next c
Next r
나머지 코드들은 실제 소스를 보면 이해가 될거라고 봅니다.
전체 소스는 아래와 같고, 소스가 들어 있는 엑셀 파일도 페이지 맨 밑에 다운로드할 수 있게 해놨습니다.
'Program 모듈
Option Explicit
Sub SetTurbo(is_on As Boolean)
If is_on Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual '매크로 속도를 엄청 빠르게 만듬
Else
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End If
End Sub
'주어진 시트의 칼럼에 대해 유니크한 데이터만 추려서 소팅 후 리턴
Function GetUniqueData(src_sheet As Worksheet, col_num As Long) As Variant
Dim sr As Long, sc As Long
Dim er As Long, ec As Long
Dim data_rng As Range
sr = 2
sc = col_num
src_sheet.Activate
Cells(sr, sc).Select
er = Selection.End(xlDown).Row
Set data_rng = Range(Cells(sr, sc), Cells(er, sc))
Dim data(), dict As Object, r As Long
Set dict = CreateObject("Scripting.Dictionary")
data = data_rng.Value
For r = 1 To UBound(data)
dict(data(r, 1)) = Empty
Next r
data = dict.keys
Call Common.QuickSort(data, LBound(data), UBound(data))
GetUniqueData = data
End Function
Sub MakeFormat(tgt_sheet As Worksheet, dates As Variant, countries As Variant)
Dim i As Long, j As Long
Dim dates_len As Long, countries_len As Long
dates_len = UBound(dates) - LBound(dates) + 1
countries_len = UBound(countries) - LBound(countries) + 1
tgt_sheet.Activate
Cells(1, 1).Value = "Date"
Range(Cells(4, 1), Cells(4 + dates_len - 1, 1)).Value = Application.Transpose(dates)
Call SetTurbo(True)
For j = 0 To countries_len - 1
Cells(1, j * 6 + 2).Value = countries(j)
Cells(2, j * 6 + 2).Value = "Case"
Cells(2, j * 6 + 5).Value = "Death"
Cells(3, j * 6 + 2).Value = "new"
Cells(3, j * 6 + 3).Value = "cumul"
Cells(3, j * 6 + 4).Value = "rank"
Cells(3, j * 6 + 5).Value = "new"
Cells(3, j * 6 + 6).Value = "cumul"
Cells(3, j * 6 + 7).Value = "rank"
Next j
Call SetTurbo(False)
End Sub
Sub MakeCasesDict(dict As Object, sheet As Worksheet)
Dim sr As Long, sc As Long
Dim er As Long
sheet.Activate
sr = 2
Cells(sr, 1).Select
er = Selection.End(xlDown).Row
Dim dates(), countries(), cases_deaths()
dates = Range(Cells(sr, 1), Cells(er, 1)).Value
countries = Range(Cells(sr, 7), Cells(er, 7)).Value
cases_deaths = Range(Cells(sr, 5), Cells(er, 6)).Value
Dim i As Long
Dim key As String
For i = 1 To (er - sr) + 1
key = dates(i, 1) & countries(i, 1)
dict(key) = Array(cases_deaths(i, 1), cases_deaths(i, 2))
Next i
End Sub
Sub WriteCaseDeath(sheet As Worksheet, dict As Object)
Dim sr As Long, sc As Long
Dim er As Long, ec As Long
sheet.Activate
Cells(4, 1).Select
er = Selection.End(xlDown).Row
Cells(3, 2).Select
ec = Selection.End(xlToRight).Column
Dim r As Long, c As Long
Dim key As String
Dim case_val, death_val
Call SetTurbo(True)
Range(Cells(4, 2), Cells(er, ec)).NumberFormat = "0"
For r = 4 To er
For c = 2 To ec Step 6
key = Cells(r, 1).Value & Cells(1, c).Value
If dict.Exists(key) Then
case_val = dict(key)(0)
death_val = dict(key)(1)
Else
case_val = 0
death_val = 0
End If
Cells(r, c).Value = case_val
Cells(r, c + 3).Value = death_val
Next c
Next r
Call SetTurbo(False)
End Sub
Sub CalculateCumul(sheet As Worksheet)
Dim sr As Long, sc As Long
Dim er As Long, ec As Long
sheet.Activate
sr = 4
Cells(sr, 1).Select
er = Selection.End(xlDown).Row
Cells(3, 2).Select
ec = Selection.End(xlToRight).Column
'calculate cumulated number of case and death
Call SetTurbo(True)
Dim new_data(), cumul_data() As Long
Dim arr_len As Long
arr_len = er - sr + 1
ReDim cumul_data(1 To arr_len) As Long
Dim c As Long, i As Long
For c = 2 To ec Step 6
'(1)for case data
new_data = Range(Cells(4, c), Cells(er, c)).Value
cumul_data(1) = new_data(1, 1)
For i = 2 To arr_len
cumul_data(i) = cumul_data(i - 1) + new_data(i, 1)
Next i
Range(Cells(4, c + 1), Cells(er, c + 1)).Value = Application.Transpose(cumul_data)
'(2)for death data
new_data = Range(Cells(4, c + 3), Cells(er, c + 3)).Value
cumul_data(1) = new_data(1, 1)
For i = 2 To arr_len
cumul_data(i) = cumul_data(i - 1) + new_data(i, 1)
Next i
Range(Cells(4, c + 4), Cells(er, c + 4)).Value = Application.Transpose(cumul_data)
Next c
Call SetTurbo(False)
End Sub
Sub CalculateRank(sheet As Worksheet)
Dim sr As Long, sc As Long
Dim er As Long, ec As Long
sheet.Activate
sr = 4
Cells(sr, 1).Select
er = Selection.End(xlDown).Row
sc = 2
Cells(3, sc).Select
ec = Selection.End(xlToRight).Column
'calculate cumulated number of case and death
Call SetTurbo(True)
Dim r As Long, c As Long
Dim i As Long, j As Long, k As Long
Dim country_cnt As Long
Dim tgt_val As Long
Dim rng_case As Range, rng_death As Range
Dim buff_case() As Long, buff_death() As Long
country_cnt = (ec - sc + 1) / 6
ReDim buff_case(0 To country_cnt - 1) As Long
ReDim buff_death(0 To country_cnt - 1) As Long
For r = sr To er
k = 0
For c = 3 To ec Step 6
buff_case(k) = Cells(r, c).Value
buff_death(k) = Cells(r, c + 3).Value
k = k + 1
Next c
Set rng_case = Range(Cells(r, ec + 1), Cells(r, ec + 1 + country_cnt - 1))
Set rng_death = Range(Cells(r + 1, ec + 1), Cells(r + 1, ec + 1 + country_cnt - 1))
rng_case.Value = buff_case
rng_death.Value = buff_death
For c = 3 To ec Step 6
tgt_val = Cells(r, c).Value 'case_cumul
Cells(r, c + 1).Value = WorksheetFunction.Rank_Eq(tgt_val, rng_case, 0)
tgt_val = Cells(r, c + 3).Value 'death_cumul
Cells(r, c + 4).Value = WorksheetFunction.Rank_Eq(tgt_val, rng_death, 0)
Next c
Next r
Call SetTurbo(False)
End Sub
Sub RankCountryByCumulData(data_sheet As Worksheet, rank_sheet As Worksheet)
Dim i As Long, j As Long, r As Long, c As Long, k As Long
Dim sr As Long, sc As Long, er As Long, ec As Long
Dim country_cnt As Long
data_sheet.Activate
sr = 4
Cells(sr, 1).Select
er = Selection.End(xlDown).Row
sc = 2
Cells(3, sc).Select
ec = Selection.End(xlToRight).Column
country_cnt = (ec - sc + 1) / 6
Dim date_str As String, country As String
Dim cumul As Long
Call SetTurbo(True)
For r = 4 To er
date_str = data_sheet.Cells(r, 1).Value
rank_sheet.Cells(1, (r - 3) * 2).Value = date_str
k = 2
For c = 2 To ec Step 6
country = data_sheet.Cells(1, c).Value
cumul = data_sheet.Cells(r, c + 1).Value
If cumul > 0 Then
rank_sheet.Cells(k, (r - 3) * 2).Value = country
rank_sheet.Cells(k, (r - 3) * 2 + 1).Value = cumul
k = k + 1
End If
Next c
If k > 1 Then
Call Common.RangeSorting(rank_sheet, 2, (r - 3) * 2, 1 + k, (r - 3) * 2 + 1)
End If
Next r
Call SetTurbo(False)
End Sub
'''''''''''''''''''''''''''''''''''''''''''
Sub ConvertSourceData()
Dim wb As Workbook
Dim src_sheet As Worksheet, tgt_sheet As Worksheet
Dim prg_sheet As Worksheet
Dim src_file_name As String, src_sheet_name
Set prg_sheet = Workbooks("program.xlsm").Sheets("program")
src_file_name = prg_sheet.Cells(12, 12).Value
src_sheet_name = prg_sheet.Cells(13, 12).Value
Set wb = Workbooks(src_file_name)
Set src_sheet = wb.Sheets(src_sheet_name)
'1. Create target sheet as "data"
src_sheet.Activate
Sheets.Add.Name = "data"
Set tgt_sheet = Sheets("data")
'2. Get unique date and countries
Dim dates As Variant, countries As Variant
dates = GetUniqueData(src_sheet, 1)
countries = GetUniqueData(src_sheet, 7)
'3. make format
Call MakeFormat(tgt_sheet, dates, countries)
'4 create dictionary for cases and deaths
Dim cases_deaths As Object
Set cases_deaths = CreateObject("Scripting.Dictionary")
Call MakeCasesDict(cases_deaths, src_sheet)
'5 write case and death value
Call WriteCaseDeath(tgt_sheet, cases_deaths)
'6. Calculate Cumulated data
Call CalculateCumul(tgt_sheet)
'7. Calculate rank
Call CalculateRank(tgt_sheet)
'8. Create rank sheet
src_sheet.Activate
Sheets.Add.Name = "rank"
Dim rank_sheet As Worksheet
Set rank_sheet = Sheets("rank")
Call RankCountryByCumulData(tgt_sheet, rank_sheet)
End Sub
'Common 모듈
Option Explicit
'usage: QuickSort(arr,LBound(arr), UBound(arr))
Sub QuickSort(ByRef arr As Variant, Lo As Long, Hi As Long)
Dim varPivot As Variant, varTmp As Variant
Dim tmpLow As Long, tmpHi As Long
tmpLow = Lo
tmpHi = Hi
varPivot = arr((Lo + Hi) / 2)
Do While tmpLow <= tmpHi
Do While arr(tmpLow) < varPivot And tmpLow < Hi
tmpLow = tmpLow + 1
Loop
Do While varPivot < arr(tmpHi) And tmpHi > Lo
tmpHi = tmpHi - 1
Loop
If tmpLow <= tmpHi Then
varTmp = arr(tmpLow)
arr(tmpLow) = arr(tmpHi)
arr(tmpHi) = varTmp
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Loop
If Lo < tmpHi Then QuickSort arr, Lo, tmpHi
If tmpLow < Hi Then QuickSort arr, tmpLow, Hi
End Sub
Sub RangeSorting(sheet As Worksheet, sr As Long, sc As Long, er As Long, ec As Long)
sheet.Activate
Dim rng As Range, key_rng As Range
Set rng = Range(Cells(sr, sc), Cells(er, ec))
Set key_rng = Range(Cells(sr, ec), Cells(er, ec))
sheet.Sort.SortFields.Clear
sheet.Sort.SortFields.Add key:=key_rng, _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With sheet.Sort
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
위 소스코드가 들어 있는 엑셀파일은,
-끝-
반응형
'Information > Corona19(COVID19)' 카테고리의 다른 글
| 코로나 확진자 수/ 사망자 수에 대한 물방울 차트(Bubble Chart) 애니메이션 (0) | 2020.12.10 |
|---|---|
| 국가별 코로나(COVID-19) 확진자 그래프 그리기 (0) | 2020.12.10 |
| 전세계 COVID19 확진자 수 분석 (2020.06.12 기준) (0) | 2020.06.13 |
| Country ranking by Corona19 infection worldwide (0) | 2020.05.25 |
| 코로나19(Corona19, COVID19) 엑셀 데이터 얻기/가공하기(1/2) (0) | 2020.05.22 |
