【VBA】構造体配列をクイックソートして結果をシートに表示する
<機能>
構造体配列のクイックソートを行い結果をシートに表示します
クイックソートの基準値(PIVOT)を左端、中央、右端より選択します
<サンプルデータ>
総務省の「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」を下記構造体の要素に格納しています
・団体コード
・都道府県名
・人口(男)
・人口(女)
・人口計
ソート対象の要素は人口計(SCT_Population.population)です
データの出典:総務省「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」
http://www.soumu.go.jp/menu_news/s-news/01gyosei02_03000062.html
<使い方>
ソース全体をそのまま張り付けてください
「都道府県別人口クイックソート()」を呼び出すと、アクティブシートに結果を表示します
<イメージ>
QuickSort呼び出し前と、QuickSort呼び出し後のデータの並びです
'//人口動態データ格納構造体を宣言
Type SCT_Population
code As String '//団体コード
prefectures As String '//都道府県名
man As Long '//男
woman As Long '//女
population As Long '//人口計
End Type
'//*********************************************
'//メイン処理
'//1.クイックソート対象データ(人口動態)をセット
'//2.クイックソート処理呼び出し
'//3.データをシートに表示
'//*********************************************
Public Sub 都道府県別人口クイックソート()
Dim popData() As SCT_Population
Dim i As Integer, gyo As Integer
'//総務省から取得した人口動態データをセット
Call SetPopulationData(popData)
'//人口(population)でクイックソート
Call QuickSort(popData, LBound(popData), UBound(popData))
'//全て(数式、文字列、書式、コメント、アウトライン)クリア
Cells.Select
Selection.Clear
'//列の幅、フォントサイズをセット
Selection.ColumnWidth = 10
Selection.Font.Size = 9
Range("A1").Select
Cells(1, 1) = "No"
Cells(1, 2) = "団体コード"
Cells(1, 3) = "都道府県"
Cells(1, 4) = "人口計"
Cells(1, 5) = "人口(男)"
Cells(1, 6) = "人口(女)"
'//データをシートに表示
For i = 0 To UBound(popData)
Cells(i + 2, 1) = i + 1
Cells(i + 2, 2) = popData(i).code
Cells(i + 2, 2).NumberFormatLocal = "@"
Cells(i + 2, 3) = popData(i).prefectures
Cells(i + 2, 4) = popData(i).population
Cells(i + 2, 5) = popData(i).man
Cells(i + 2, 6) = popData(i).woman
'//書式をセット
Cells(i + 2, 2).NumberFormatLocal = "@"
Cells(i + 2, 4).NumberFormatLocal = "###,###,##0"
Cells(i + 2, 5).NumberFormatLocal = "###,###,##0"
Cells(i + 2, 6).NumberFormatLocal = "###,###,##0"
Next
End Sub
'//メイン処理
'//1.クイックソート対象データ(人口動態)をセット
'//2.クイックソート処理呼び出し
'//3.データをシートに表示
'//*********************************************
Public Sub 都道府県別人口クイックソート()
Dim popData() As SCT_Population
Dim i As Integer, gyo As Integer
'//総務省から取得した人口動態データをセット
Call SetPopulationData(popData)
'//人口(population)でクイックソート
Call QuickSort(popData, LBound(popData), UBound(popData))
'//全て(数式、文字列、書式、コメント、アウトライン)クリア
Cells.Select
Selection.Clear
'//列の幅、フォントサイズをセット
Selection.ColumnWidth = 10
Selection.Font.Size = 9
Range("A1").Select
Cells(1, 1) = "No"
Cells(1, 2) = "団体コード"
Cells(1, 3) = "都道府県"
Cells(1, 4) = "人口計"
Cells(1, 5) = "人口(男)"
Cells(1, 6) = "人口(女)"
'//データをシートに表示
For i = 0 To UBound(popData)
Cells(i + 2, 1) = i + 1
Cells(i + 2, 2) = popData(i).code
Cells(i + 2, 2).NumberFormatLocal = "@"
Cells(i + 2, 3) = popData(i).prefectures
Cells(i + 2, 4) = popData(i).population
Cells(i + 2, 5) = popData(i).man
Cells(i + 2, 6) = popData(i).woman
'//書式をセット
Cells(i + 2, 2).NumberFormatLocal = "@"
Cells(i + 2, 4).NumberFormatLocal = "###,###,##0"
Cells(i + 2, 5).NumberFormatLocal = "###,###,##0"
Cells(i + 2, 6).NumberFormatLocal = "###,###,##0"
Next
End Sub
'//*********************************************
'//都道府県別人口動態データを人口(population)でクイックソートする
'//*********************************************
Public Sub QuickSort(ByRef popData() As SCT_Population, ByVal st As Integer, ByVal ed As Long)
Dim lpos As Long
Dim rpos As Long
Dim pivot As Long, pivotidx As Long
Dim wk As SCT_Population
'//先頭データ、中央データ、終端データよりピボットデータのインデックスを取得する
pivotidx = GetPivotIndex(st, (st + ed) ¥ 2, ed, popData)
'//ピボット(基準値)を取得
pivot = popData(pivotidx).population
lpos = st
rpos = ed
Do
'//ピボットより人口計の値が小さい最大インデックスを取得
Do While popData(lpos).population < pivot
lpos = lpos + 1
Loop
'//ピボットより人口計の値が大きい最小インデックスを取得
Do While popData(rpos).population > pivot
rpos = rpos - 1
Loop
'//インデックスが交わったら基準値の左、基準値の右への分割終了
If lpos >= rpos Then
Exit Do
Else
'//左右の要素を入れ替え
wk.code = popData(lpos).code
wk.prefectures = popData(lpos).prefectures
wk.man = popData(lpos).man
wk.woman = popData(lpos).woman
wk.population = popData(lpos).population
popData(lpos).code = popData(rpos).code
popData(lpos).prefectures = popData(rpos).prefectures
popData(lpos).man = popData(rpos).man
popData(lpos).woman = popData(rpos).woman
popData(lpos).population = popData(rpos).population
popData(rpos).code = wk.code
popData(rpos).prefectures = wk.prefectures
popData(rpos).man = wk.man
popData(rpos).woman = wk.woman
popData(rpos).population = wk.population
lpos = lpos + 1
rpos = rpos - 1
End If
Loop
'//再帰処理で左右をクイックソートする
If st < lpos - 1 Then
Call QuickSort(popData, st, lpos - 1)
End If
If ed > rpos + 1 Then
Call QuickSort(popData, rpos + 1, ed)
End If
End Sub
'//都道府県別人口動態データを人口(population)でクイックソートする
'//*********************************************
Public Sub QuickSort(ByRef popData() As SCT_Population, ByVal st As Integer, ByVal ed As Long)
Dim lpos As Long
Dim rpos As Long
Dim pivot As Long, pivotidx As Long
Dim wk As SCT_Population
'//先頭データ、中央データ、終端データよりピボットデータのインデックスを取得する
pivotidx = GetPivotIndex(st, (st + ed) ¥ 2, ed, popData)
'//ピボット(基準値)を取得
pivot = popData(pivotidx).population
lpos = st
rpos = ed
Do
'//ピボットより人口計の値が小さい最大インデックスを取得
Do While popData(lpos).population < pivot
lpos = lpos + 1
Loop
'//ピボットより人口計の値が大きい最小インデックスを取得
Do While popData(rpos).population > pivot
rpos = rpos - 1
Loop
'//インデックスが交わったら基準値の左、基準値の右への分割終了
If lpos >= rpos Then
Exit Do
Else
'//左右の要素を入れ替え
wk.code = popData(lpos).code
wk.prefectures = popData(lpos).prefectures
wk.man = popData(lpos).man
wk.woman = popData(lpos).woman
wk.population = popData(lpos).population
popData(lpos).code = popData(rpos).code
popData(lpos).prefectures = popData(rpos).prefectures
popData(lpos).man = popData(rpos).man
popData(lpos).woman = popData(rpos).woman
popData(lpos).population = popData(rpos).population
popData(rpos).code = wk.code
popData(rpos).prefectures = wk.prefectures
popData(rpos).man = wk.man
popData(rpos).woman = wk.woman
popData(rpos).population = wk.population
lpos = lpos + 1
rpos = rpos - 1
End If
Loop
'//再帰処理で左右をクイックソートする
If st < lpos - 1 Then
Call QuickSort(popData, st, lpos - 1)
End If
If ed > rpos + 1 Then
Call QuickSort(popData, rpos + 1, ed)
End If
End Sub
'//*********************************************
'//ピボット(基準値)のインデックスを取得する
'//*********************************************
Private Function GetPivotIndex(ByVal lidx As Long, ByVal midx As Long, ByVal ridx As Long, ByRef popData() As SCT_Population) As Long
Dim leftpop As Long, midpop As Long, rightpop As Long
leftpop = popData(lidx).population
midpop = popData(midx).population
rightpop = popData(ridx).population
'//初期値は左データ
GetPivotIndex = lidx
'//3つの値のメジアンを選択する
If (leftpop < midpop) And (midpop < rightpop) Then
GetPivotIndex = midx
Exit Function
End If
If (leftpop > midpop) And (midpop > rightpop) Then
GetPivotIndex = midx
Exit Function
End If
If (leftpop < rightpop) And (rightpop < midpop) Then
GetPivotIndex = ridx
Exit Function
End If
If (leftpop > rightpop) And (rightpop > midpop) Then
GetPivotIndex = ridx
Exit Function
End If
End Function
'//ピボット(基準値)のインデックスを取得する
'//*********************************************
Private Function GetPivotIndex(ByVal lidx As Long, ByVal midx As Long, ByVal ridx As Long, ByRef popData() As SCT_Population) As Long
Dim leftpop As Long, midpop As Long, rightpop As Long
leftpop = popData(lidx).population
midpop = popData(midx).population
rightpop = popData(ridx).population
'//初期値は左データ
GetPivotIndex = lidx
'//3つの値のメジアンを選択する
If (leftpop < midpop) And (midpop < rightpop) Then
GetPivotIndex = midx
Exit Function
End If
If (leftpop > midpop) And (midpop > rightpop) Then
GetPivotIndex = midx
Exit Function
End If
If (leftpop < rightpop) And (rightpop < midpop) Then
GetPivotIndex = ridx
Exit Function
End If
If (leftpop > rightpop) And (rightpop > midpop) Then
GetPivotIndex = ridx
Exit Function
End If
End Function
'//*********************************************
'//人口動態データセット
'//総務省「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」より取得
'//http://www.soumu.go.jp/menu_news/s-news/01gyosei02_03000062.html
'//*********************************************
Private Sub SetPopulationData(ByRef popData() As SCT_Population)
Dim ar As Variant
Dim wkStr() As String
Dim i As Integer
ar = Array( _
"010006,北海道,2568237,2863421,5431658", "020001,青森県,641035,712301,1353336", "030007,岩手県,624594,676369,1300963", _
"040002,宮城県,1135024,1193109,2328133", "050008,秋田県,497843,558736,1056579", "060003,山形県,548411,592324,1140735", _
"070009,福島県,960877,1004509,1965386", "080004,茨城県,1490931,1490842,2981773", "090000,栃木県,997942,1006475,2004417", _
"100005,群馬県,994458,1017745,2012203", "110001,埼玉県,3662212,3642684,7304896", "120006,千葉県,3124578,3129528,6254106", _
"130001,東京都,6565648,6731937,13297585", "140007,神奈川県,4561879,4554787,9116666", "150002,新潟県,1133087,1204398,2337485", _
"160008,富山県,524381,561329,1085710", "170003,石川県,560407,599356,1159763", "180009,福井県,389160,414345,803505", _
"190004,山梨県,418832,436670,855502", "200000,長野県,1046859,1101644,2148503", "210005,岐阜県,1014767,1072828,2087595", _
"220001,静岡県,1868542,1917564,3786106", "230006,愛知県,3750112,3739834,7489946", "240001,三重県,907884,952229,1860113", _
"250007,滋賀県,700498,720844,1421342", "260002,京都府,1238027,1341278,2579305", "270008,大阪府,4293467,4575403,8868870", _
"280003,兵庫県,2706852,2931486,5638338", "290009,奈良県,664483,731165,1395648", "300004,和歌山県,475263,528467,1003730", _
"310000,鳥取県,278558,304793,583351", "320005,島根県,337087,369111,706198", "330001,岡山県,934882,1004840,1939722", _
"340006,広島県,1388164,1480995,2869159", "350001,山口県,678003,753537,1431540", "360007,徳島県,370236,406331,776567", _
"370002,香川県,484723,520847,1005570", "380008,愛媛県,675440,750927,1426367", "390003,高知県,351939,395183,747122", _
"400009,福岡県,2431931,2688266,5120197", "410004,佐賀県,401320,446104,847424", "420000,長崎県,663602,749553,1413155", _
"430005,熊本県,859109,959205,1818314", "440001,大分県,564631,626167,1190798", "450006,宮崎県,536561,599091,1135652", _
"460001,鹿児島県,795137,896290,1691427", "470007,沖縄県,716788,737235,1454023")
For i = 0 To UBound(ar)
wkStr = Split(ar(i), ",")
ReDim Preserve popData(i)
popData(i).code = wkStr(0)
popData(i).prefectures = wkStr(1)
popData(i).man = CLng(wkStr(2))
popData(i).woman = CLng(wkStr(3))
popData(i).population = CLng(wkStr(4))
Next
End Sub
'//人口動態データセット
'//総務省「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」より取得
'//http://www.soumu.go.jp/menu_news/s-news/01gyosei02_03000062.html
'//*********************************************
Private Sub SetPopulationData(ByRef popData() As SCT_Population)
Dim ar As Variant
Dim wkStr() As String
Dim i As Integer
ar = Array( _
"010006,北海道,2568237,2863421,5431658", "020001,青森県,641035,712301,1353336", "030007,岩手県,624594,676369,1300963", _
"040002,宮城県,1135024,1193109,2328133", "050008,秋田県,497843,558736,1056579", "060003,山形県,548411,592324,1140735", _
"070009,福島県,960877,1004509,1965386", "080004,茨城県,1490931,1490842,2981773", "090000,栃木県,997942,1006475,2004417", _
"100005,群馬県,994458,1017745,2012203", "110001,埼玉県,3662212,3642684,7304896", "120006,千葉県,3124578,3129528,6254106", _
"130001,東京都,6565648,6731937,13297585", "140007,神奈川県,4561879,4554787,9116666", "150002,新潟県,1133087,1204398,2337485", _
"160008,富山県,524381,561329,1085710", "170003,石川県,560407,599356,1159763", "180009,福井県,389160,414345,803505", _
"190004,山梨県,418832,436670,855502", "200000,長野県,1046859,1101644,2148503", "210005,岐阜県,1014767,1072828,2087595", _
"220001,静岡県,1868542,1917564,3786106", "230006,愛知県,3750112,3739834,7489946", "240001,三重県,907884,952229,1860113", _
"250007,滋賀県,700498,720844,1421342", "260002,京都府,1238027,1341278,2579305", "270008,大阪府,4293467,4575403,8868870", _
"280003,兵庫県,2706852,2931486,5638338", "290009,奈良県,664483,731165,1395648", "300004,和歌山県,475263,528467,1003730", _
"310000,鳥取県,278558,304793,583351", "320005,島根県,337087,369111,706198", "330001,岡山県,934882,1004840,1939722", _
"340006,広島県,1388164,1480995,2869159", "350001,山口県,678003,753537,1431540", "360007,徳島県,370236,406331,776567", _
"370002,香川県,484723,520847,1005570", "380008,愛媛県,675440,750927,1426367", "390003,高知県,351939,395183,747122", _
"400009,福岡県,2431931,2688266,5120197", "410004,佐賀県,401320,446104,847424", "420000,長崎県,663602,749553,1413155", _
"430005,熊本県,859109,959205,1818314", "440001,大分県,564631,626167,1190798", "450006,宮崎県,536561,599091,1135652", _
"460001,鹿児島県,795137,896290,1691427", "470007,沖縄県,716788,737235,1454023")
For i = 0 To UBound(ar)
wkStr = Split(ar(i), ",")
ReDim Preserve popData(i)
popData(i).code = wkStr(0)
popData(i).prefectures = wkStr(1)
popData(i).man = CLng(wkStr(2))
popData(i).woman = CLng(wkStr(3))
popData(i).population = CLng(wkStr(4))
Next
End Sub
よろしければポチッと押してください