【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
          1
    2345678
    9101112131415
    16171819202122
    23242526272829
    30      
    << September 2018 >>

    profile

    others

    mobile

    qrcode         スマホ表示に戻す