【VBA】構造体配列をクイックソートして結果をシートに表示する

0

    <機能>
    構造体配列のクイックソートを行い結果をシートに表示します
    クイックソートの基準値(PIVOT)を左端、中央、右端より選択します

    <サンプルデータ>
    総務省の「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」を下記構造体の要素に格納しています
    ・団体コード
    ・都道府県名
    ・人口(男)
    ・人口(女)
    ・人口計
    ソート対象の要素は人口計(SCT_Population.population)です

    データの出典:総務省「住民基本台帳に基づく人口、人口動態及び世帯数(平成27年1月1日現在)」
    http://www.soumu.go.jp/menu_news/s-news/01gyosei02_03000062.html

    <使い方>
    ソース全体をそのまま張り付けてください
    「都道府県別人口クイックソート()」を呼び出すと、アクティブシートに結果を表示します

    <イメージ>
    QuickSort呼び出し前と、QuickSort呼び出し後のデータの並びです
    ソート前イメージ、クイックソート、QuickSort、VBA      ソート後イメージ、クイックソート、QuickSort、VBA
     

    '//人口動態データ格納構造体を宣言

    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

     

     

    '//都道府県別人口動態データを人口(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

     

    '//人口動態データセット

    '//総務省「住民基本台帳に基づく人口、人口動態及び世帯数(平成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

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    calendar

    S M T W T F S
    1234567
    891011121314
    15161718192021
    22232425262728
    293031    
    << October 2017 >>

    profile

    others

    mobile

    qrcode