【VBA】連想配列(二次元もどき)でキーごとに集計を行う

0

    <機能>
    (1)VBAの連想配列でキー文字列ごとに集計を行います
    (2)二次元もどきの連想配列で集計項目2つを同時に処理します
    (3)過去3年間のプロ野球ペナントレースでの勝ち数、負け数を集計します
    (4)連想配列メソッド(Add/Count/exists/Keys/Items)のサンプルを掲載

    <動作検証&開発環境>
    Microsoft Office 2010

    <使い方>
    適当なところにソースを張り付けて「二次元もどき連想配列で集計処理を行う()」を呼び出してください

    <イメージ>
    二次元もどき連想配列を用いてチーム名をキーとして、2つの項目(勝ち数、負け数)を同時に集計を行います
    実行イメージ、連想配列、二次元、2次元、CreateObject、Scripting.Dictionary、VBA

    イミディエイトウィンドウに連想配列メソッドのサンプル実行結果を出力します
    ※ウィンドウが表示されていない場合はVBEの 表示 → イミディエイトウィンドウ で表示できます
    イミディエイトウィンドウ、連想配列、二次元、2次元、CreateObject、Scripting.Dictionary、VBA


    '********************************************
    '連想配列を使用してVBAで集計処理を行います
    '疑似二次元配列で集計します
    'プロ野球の過去3年間(2013-2015)のチーム毎の勝ち数、負け数を集計します
    '********************************************

    Sub 二次元もどき連想配列で集計処理を行う()
        Dim gyo As Long, lastgyo As Long
        Dim skey As String
        Dim i As Integer
        Dim arkey As Variant

        '//全て(数式、文字列、書式、コメント、アウトライン)クリア
        Cells.Select
        Selection.Clear
        Selection.ColumnWidth = 10
        Selection.RowHeight = 19
        Selection.Font.Name = "MS ゴシック"
        Selection.Font.Size = 12
        Columns("B").ColumnWidth = 30
        Range("A1").Select
        
        '//テスト用のサンプルデータをシートにセット
        SetTestData
        
        '//データの入っている最終行を取得
        lastgyo = Range("A65536").End(xlUp).Row
        '//データ有無(最低1シーズン分のデータが存在)を判定
        If lastgyo < 8 Then
            MsgBox "データがありません", vbExclamation
            Exit Sub
        End If
        
        '//連想配列を2つ用意
        '//Dim dic as New Dictionary で宣言する場合は
        '//[ツール]→[参照設定]で Microsoft Scripting Runtime にチェックを入れてください

        Set dic1 = CreateObject("Scripting.Dictionary")
        Set dic2 = CreateObject("Scripting.Dictionary")
        
        '//チーム毎に勝ち数・負け数を集計(3列目と4列目を集計)
        For gyo = 2 To lastgyo
            '連想配列なので数値以外(チーム名)をインデックスに配列を作成
            skey = Cells(gyo, 2).Value
            '勝ち数を集計
            dic1(skey) = dic1(skey) + CInt(Cells(gyo, 3).Value)
            '負け数を集計(疑似二次元配列)
            dic2(skey) = dic2(skey) + CInt(Cells(gyo, 4).Value)
        Next
        
        '//シートに項目行を出力する
        Columns(6).ColumnWidth = 30
        Columns(7).ColumnWidth = 15
        Columns(8).ColumnWidth = 15
        Cells(1, 6).Value = "チーム名"
        Cells(1, 7).Value = "3年間の勝ち数"
        Cells(1, 8).Value = "3年間の負け数"
        
        '//連想配列のキーの要素を取得
        '//dic2から取得しても同じ

        arkey = dic1.Keys
        
        '//シートに勝ち数の結果を出力
        For i = 0 To UBound(arkey)
            Cells(i + 2, 6).Value = arkey(i)
            Cells(i + 2, 7).Value = dic1.Item(arkey(i))
            Cells(i + 2, 8).Value = dic2.Item(arkey(i))
        Next
        
        Set dic1 = Nothing
        Set dic2 = Nothing
        
        '///// ここから参考 連想配列のメソッド /////
        '//(参考)連想配列のメソッド

        Set dic = CreateObject("Scripting.Dictionary")
        Dim ar1 As Variant, ar2 As Variant
        Dim j As Integer
        
        '//(1)配列に要素を追加
        dic.Add "犬", "ワンワン"
        dic.Add "ねこ", "ニャー"
        dic.Add "牛", "モーモー"
        '//(2)要素数を取得
        Debug.Print "連想配列の要素数:" & CStr(dic.Count)
        '//(3)キーに対応するアイテムが存在するか判定する(True/False)
        If dic.exists("ねこ") Then Debug.Print "キー「ねこ」は存在します"
        If Not dic.exists("馬") Then Debug.Print "キー「馬」は存在しません"
        '//(4)キーに対応するアイテムを取得する
        Debug.Print "ねこは「" & dic.Item("ねこ") & "と鳴きます"
        '//(5)要素を削除する
        dic.Remove "ねこ"
        If Not dic.exists("ねこ") Then Debug.Print "キー「ねこ」は存在しません"
        '//(6)KeyとItemの一覧を取得する
        artest1 = dic.Keys
        artest2 = dic.Items
        For j = 0 To UBound(artest1)
            Debug.Print artest1(j) & "は「" & artest2(j) & "と鳴きます"
        Next
        
        Set dic = Nothing
    End Sub

    '********************************************
    'テスト用のCSVファイルをシートに展開
    'カラム1:年度
    'カラム2:チーム名
    'カラム3:勝ち数
    'カラム4:負け数
    '********************************************

    Private Sub SetTestData()
        Dim ar As Variant
        Dim wkStr() As String
        Dim i As Integer
        
        ar = Array("年度,チーム名,勝ち数,負け数,", _
        "2015,東京ヤクルトスワローズ,76,65,", "2015,読売ジャイアンツ,75,67,", _
        "2015,阪神タイガース,70,71,", "2015,広島東洋カープ,69,71,", _
        "2015,中日ドラゴンズ,62,77,", "2015,横浜DeNAベイスターズ,62,80,", _
        "2015,福岡ソフトバンクホークス,90,49,", "2015,北海道日本ハムファイターズ,79,62,", _
        "2015,千葉ロッテマリーンズ,73,69,", "2015,埼玉西武ライオンズ,69,69,", _
        "2015,オリックス・バファローズ,61,80,", "2015,東北楽天ゴールデンイーグルス,57,83,", _
        "2014,読売ジャイアンツ,82,61,", "2014,阪神タイガース,75,68,", _
        "2014,広島東洋カープ,74,68,", "2014,中日ドラゴンズ,67,73,", _
        "2014,横浜DeNAベイスターズ,67,75,", "2014,東京ヤクルトスワローズ,60,81,", _
        "2014,福岡ソフトバンクホークス,78,60,", "2014,オリックス・バファローズ,80,62,", _
        "2014,北海道日本ハムファイターズ,73,68,", "2014,千葉ロッテマリーンズ,66,76,", _
        "2014,埼玉西武ライオンズ,63,77,", "2014,東北楽天ゴールデンイーグルス,64,80,", _
        "2013,読売ジャイアンツ,84,53,", "2013,阪神タイガース,73,67,", _
        "2013,広島東洋カープ,69,72,", "2013,中日ドラゴンズ,64,77,", _
        "2013,横浜DeNAベイスターズ,64,79,", "2013,東京ヤクルトスワローズ,57,83,", _
        "2013,東北楽天ゴールデンイーグルス,82,59,", "2013,埼玉西武ライオンズ,74,66,", _
        "2013,千葉ロッテマリーンズ,74,68,", "2013,福岡ソフトバンクホークス,73,69,", _
        "2013,オリックス・バファローズ,66,73,", "2013,北海道日本ハムファイターズ,64,78,")
        
        For i = 0 To UBound(ar)
            wkStr = Split(ar(i), ",")
            Cells(i + 1, 1).Value = wkStr(0)
            Cells(i + 1, 2).Value = wkStr(1)
            Cells(i + 1, 3).Value = wkStr(2)
            Cells(i + 1, 4).Value = wkStr(3)
        Next
    End Sub
     

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

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



    selected entries

    categories

    calendar

    S M T W T F S
         12
    3456789
    10111213141516
    17181920212223
    24252627282930
    31      
    << March 2024 >>

    profile

    others

    archives