連想配列(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でもろもろ高速化してみよう！
今回使ったのは年齢（５歳階級），男女別人口－都道府県（大正９年～平成27年）を加工して作成したデータです。
データをいろいろ解析してみる
今回は、北海道というシートを作り、かつ、その中に年代別の総人口、男性の総人口、女性の総人口、元号、人口が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") = "条件"
ポイントはアイテムに位置を入れること
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).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年だけはないとかになるともう少し複雑となります。
また別記事で記載します。
[temp id=2]
コメント