【VBA】SUMIFSやCOUNTIFS、VLOOKUPを複合的に超高速化!ユーザー定義型変数を使ってみた

連想配列(Dictionary)を使うことで、計算を高速で行えるようになった頃です。
いざ使ってみようと思うと、かゆいところに手が届かない。
というか使いにくいです(笑)

これ使う意味ある?
と思ってしまいました。


なんとか実用化しようと思い、いろいろ試行錯誤。
ユーザー定義型変数IF関数の乱用によって、やっと形になったはず?なので忘れないようまとめます。

【超高速化】Excel VBAを使ってSUMIF&SUMIFS関数を効率的に実行してみた 【基礎編】
【高速化】Excel VBAを使ってCOUNTIF関数を効率化
Excel VBAを使ってCOUNTIFS関数を超高速化!条件を&で結合してやってみた

スポンサーリンク

ユーザー定義型変数ってなに?

まずはじめに、ユーザー定義型変数について簡単にだけ解説します。

ユーザー定義型変数とは、1つの変数名の中にいくつかの型を自分で作れるというものです。
といってもなかなかわかりにくいもので、記述の方法から見ていきましょう。

Type user
    a As Long
    b As Long
    c As String
End Type

こんな感じです。

普通変数を使うときって
Dim a As Long
このように書きますよね。

それと一緒なんですが、その前提にuser(なんでもいい、自分でつけたい名前)と置くことで、変数をひとくくりにできるのです。

使い方としては

Sub test()
Dim ユーザー定義型 As user 'まずは宣言する

ユーザー定義型.a = 1

ユーザー定義型.b = 2

ユーザー定義型.c = "こんにちわ"


Debug.Print ユーザー定義型.a
Debug.Print ユーザー定義型.b
Debug.Print ユーザー定義型.c

End Sub

イミディエイトウィンドウを開くと


こんにちわ
とでます。

1つの変数に複数の型を持たせることができるのです。

スポンサーリンク

VBAでもろもろ高速化してみよう!

今回使ったのは年齢(5歳階級),男女別人口-都道府県(大正9年~平成27年)を加工して作成したデータです。

出典:政府統計の総合窓口(e-Stat)(https://www.e-stat.go.jp/)を加工して作成

データをいろいろ解析してみる

今回は、北海道というシートを作り、かつ、その中に年代別の総人口、男性の総人口、女性の総人口、元号、人口が150000以上だった回数をまとめてみたいと思います。

長くなるので細かくいきます。

下準備から

Type user
    total As Long
    men As Long
    women As Long
    gengou As String
End Type

必要な分だけユーザー定義型変数を宣言。

    Dim 重複用
    Dim maxrow As Long
    maxrow = Cells(Rows.Count, 6).End(xlUp).Row
    
    重複用 = Range("F1:F" & maxrow)
    Range("O1:O" & maxrow) = 重複用
    
    Range("O1:O" & maxrow).RemoveDuplicates Columns:=Array(1), Header:=xlYes '重複削除


    Dim 年代
    Dim maxrowO
    maxrowO = Cells(Rows.Count, 15).End(xlUp).Row
    年代 = Range("O1:O" & maxrowO)

上記はあんまり関係ありません。
重複していない年代別のデータが欲しいだけです。
O列に

西暦(年)
1920
1925
1930
1935
1940
1945
1950

こんな感じに表示されます。
これを年代という変数に入れます。

        Dim 元データ
        Dim 保存用 
        Dim dic         As Object
          
        '①とりあえず全部格納
        条件 = Range("A1").CurrentRegion

        'Dictionaryをオブジェクト型の変数に格納
        Set dic = CreateObject("Scripting.Dictionary") 

いったんシート全体の項目を元データという変数に格納します。

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "北海道"

北海道というシートを作ります。

計算する

    Dim i           As Long
    Dim n           As Long
    Dim Key         As long
    Dim 保管用() As user

     For n = 2 To UBound(元データ) '要素数分ループさせる
                            
      Key = 元データ(n, 6)
      
    If Not 元データ(n, 3) = "総数" Then '総数は含めないため

      If Not dic.Exists(Key) Then '既存のキーと同じ値がないなら

     dic.Add Key, i 'キーとiをセットで登録
     ReDim Preserve 保管用(i) '配列の数をiと同じになるよう増やす
     
     保管用(i).total = 元データ(n, 7)
     保管用(i).men = 元データ(n, 8)
     保管用(i).women = 元データ(n, 9)
     保管用(i).gengou = 元データ(n, 4)
     
     i = i + 1 'iの数を1増やす
     
        If 元データ(n, 7) > 150000 Then
        保管用(i - 1).条件 = 1
        End If
     
     Else
     
      
     m = dic(Key)
     
     保管用(m).total = 元データ(n, 7) + 保管用(m).total
     保管用(m).men = 元データ(n, 8) + 保管用(m).men
     保管用(m).women = 元データ(n, 9) + 保管用(m).women
     
        If 元データ(n, 7) > 150000 Then
        保管用(m).条件 = 保管用(m).条件 + 1
        End If
        
    End If
    
  End If
  
Next n
  
  
  Dim 貼り付け用
  
  貼り付け用 = Range("B1:F" & maxrowO) '空のセルを格納
  
  For n = LBound(保管用) To UBound(保管用)
  
  m = dic(年代(n + 1, 1))
  貼り付け用(n + 1, 1) = 保管用(m).total
  貼り付け用(n + 1, 2) = 保管用(m).men
  貼り付け用(n + 1, 3) = 保管用(m).women
  貼り付け用(n + 1, 4) = 保管用(m).gengou
  貼り付け用(n + 1, 5) = 保管用(m).条件
  
  Next n
  
  Range("A1:A" & maxrowO) = 年代
  Range("B2:F" & maxrowO) = 貼り付け用
  
  Range("B1") = "総人口"
  Range("C1") = "男性"
  Range("D1") = "女性"
  Range("E1") = "元号"
  Range("F1") = "条件"
出典:政府統計の総合窓口(e-Stat)(https://www.e-stat.go.jp/)を加工して作成

ポイントはアイテムに位置を入れること

dic.Add Key, i

この部分で、アイテム(西暦)とi(カウンター)をセットにしています。
イメージとしては、1920,0 1925,1 1930,2
というように西暦に番号を振っています。

i = i + 1
この記載によって、重複なしの暦が出るたびにiの数を増やしていきます。

ReDim Preserveを使って配列数をiにあわせる

ReDim Preserve 保管用(i) ‘配列の数をiと同じになるよう増やす

↑は保管用という配列の数をiに合わせています。

dicに西暦をいれると番号が出る

m = dic(Key)

このようにすると、変数mにはkeyの中に入った西暦に対応する番号が格納されます。
例えばkeyが1920年でだとすると、0番なので、mは0となります。

保管用(m).total = 元データ(n, 7) + 保管用(m).total

保管用(0).total = 元データ(n, 7) + 保管用(0).total
このようにして1920年代の人口数を増やしていきます。

まとめ

Option Explicit

Type user
    total As Long
    men As Long
    women As Long
    gengou As String
    条件 As Long
End Type


Sub test1()
    Dim 重複用
    Dim maxrow As Long
    maxrow = Cells(Rows.Count, 6).End(xlUp).Row
    
    重複用 = Range("F1:F" & maxrow)
    Range("O1:O" & maxrow) = 重複用
    
    Range("O1:O" & maxrow).RemoveDuplicates Columns:=Array(1), Header:=xlYes '重複削除


    Dim 年代
    Dim maxrowO
    maxrowO = Cells(Rows.Count, 15).End(xlUp).Row
    年代 = Range("O1:O" & maxrowO)
    
        Dim 元データ
        Dim dic         As Object
          
        '①とりあえず全部格納
        元データ = Range("A1").CurrentRegion

        'Dictionaryをオブジェクト型の変数に格納
        Set dic = CreateObject("Scripting.Dictionary")
        
           Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "北海道"
    
    Dim i           As Long
    Dim n           As Long
    Dim m           As Long
    Dim Key         As Long
    Dim 保管用()    As user

    For n = 2 To UBound(元データ) '要素数分ループさせる
                            
      Key = 元データ(n, 6)
      
    If Not 元データ(n, 3) = "総数" Then '総数は含めないため

      If Not dic.Exists(Key) Then '既存のキーと同じ値がないなら

     dic.Add Key, i 'キーとiをセットで登録
     ReDim Preserve 保管用(i) '配列の数をiと同じになるよう増やす
     
     保管用(i).total = 元データ(n, 7)
     保管用(i).men = 元データ(n, 8)
     保管用(i).women = 元データ(n, 9)
     保管用(i).gengou = 元データ(n, 4)
     
     i = i + 1 'iの数を1増やす
     
        If 元データ(n, 7) > 150000 Then
        保管用(i - 1).条件 = 1
        End If
     
     Else
     
      
     m = dic(Key)
     
     保管用(m).total = 元データ(n, 7) + 保管用(m).total
     保管用(m).men = 元データ(n, 8) + 保管用(m).men
     保管用(m).women = 元データ(n, 9) + 保管用(m).women
     
        If 元データ(n, 7) > 150000 Then
        保管用(m).条件 = 保管用(m).条件 + 1
        End If
        
    End If
    
  End If
  
Next n
  
  
  Dim 貼り付け用
  
  貼り付け用 = Range("B1:F" & maxrowO) '空のセルを格納
  
  For n = LBound(保管用) To UBound(保管用)
  
  m = dic(年代(n + 1, 1))
  貼り付け用(n + 1, 1) = 保管用(m).total
  貼り付け用(n + 1, 2) = 保管用(m).men
  貼り付け用(n + 1, 3) = 保管用(m).women
  貼り付け用(n + 1, 4) = 保管用(m).gengou
  貼り付け用(n + 1, 5) = 保管用(m).条件
  
  Next n
  
  Range("A1:A" & maxrowO) = 年代
  Range("B2:F" & maxrowO) = 貼り付け用
  
  Range("B1") = "総人口"
  Range("C1") = "男性"
  Range("D1") = "女性"
  Range("E1") = "元号"
  Range("F1") = "条件"
  


End Sub

おわり

今回は条件である西暦に対応する北海道の項目がすべてあったため簡単にできました。

これが、1940年だけはないとかになるともう少し複雑となります。
また別記事で記載します。

自由コメント 登録不要です!

タイトルとURLをコピーしました