[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『連想配列を使用した「重複データを削除し合計を合算＆平均値」』（みお）
VBA初心者です。連想配列について調べましたが、どうしても理想どおりに動かせません。
以下のコードで記号の重複を削除し、個数を合計することはできます。
が、１.平均を出すこと ２.複数列を移すこと
の２つができません。
図で示すとこうゆう形にしたいです。
A列 B列 C列 D列 E列 F列
10/1 α みかん 500 2 1500
10/1 β なし 900 5 2000
10/1 α みかん 450 3 1500
10/1 π りんご 200 4 1000
10/1 π りんご 300 2 1000
10/1 α みかん 550 6 1500
↓
H列 I列 J列 K列 L列 M列
10/1 α みかん 500 11 1500
10/1 β なし 900 5 2000
10/1 π りんご 250 6 1000
条件としては、
・基準はB列が重複しているかどうかのみ。他の列はD列とE列以外は上記のように同じ。
・D列はB列の重複しているものを加算して「合計数値÷加算数」で平均値をだしたい。
・E列はB列の重複しているものを加算する。
これらの条件で連想配列でVBAを組むことは可能でしょうか？
かなり試行錯誤しましたが、連想配列で組もうとするとうまくいきません。
また組めるならばコードを教えていただきたいです。
どうかよろしくおねがいします。
Sub 重複データを削除し合計を合算()
Dim myDic As Object
Dim myKey As Variant
Dim myItem As Variant
Dim myList As Variant
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
'A列～F列のデータを配列に格納
myList = Range("A2", Range("A" & Rows.Count). _
End(xlUp)).Resize(, 6).Value
'連想配列にデータを格納
For i = 1 To UBound(myList, 1)
'記号が空欄かチェック
If Not myList(i, 2) = Empty Then
If Not myDic.exists(myList(i, 2)) Then
'重複しない記号を取得
myDic.Add Key:=myList(i, 2), Item:=myList(i, 5)
Else
'個数を加算
myDic(myList(i, 2)) = myDic(myList(i, 2)) + myList(i, 5)
End If
End If
Next
'[記号] 重複していないリストを格納
myKey = myDic.keys
'[個数] 個数の合計を格納
myItem = myDic.items
'リストを出力
For i = 0 To UBound(myKey)
Cells(i + 2, 8).Value = myKey(i)
Cells(i + 2, 9).Value = myItem(i)
Next
'開放
Set myDic = Nothing
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
A列、C列は必ずB列に連動しているか？などいろいろと気になるところはありますが、取り合えず平均を出すためには個数の情報が必要です。
Dictionary で別途集計することもできますが、関数を利用すると楽ではないでしょうか。 (ユニークな項目にするには AdvancedFilter なども利用できます。） とりあえずたたき台として、例示の結果となるサンプルです。
Sub Macro1()
Dim myDic As New Scripting.Dictionary '' ツールの参照設定で Microsoft Scripting Runtime にチェック
Dim ky
Dim r
For r = 2 To Cells(Rows.Count, "B").End(xlUp).Row
ky = Cells(r, "B")
If ky <> "" Then
If myDic.Exists(ky) = False Then myDic.Add ky, True
End If
Next
Range("I2").Resize(myDic.Count, 1) = WorksheetFunction.Transpose(myDic.Keys)
Dim numData
numData = Cells(Rows.Count, "I").End(xlUp).Row - 1
Range("H2").Resize(numData, 1).Formula = "=XLOOKUP(I2,B:B,A:A,"""",-1)"
Range("J2").Resize(numData, 1).Formula = "=XLOOKUP(I2,B:B,C:C,"""",-1)"
Range("K2").Resize(numData, 1).Formula = "=AVERAGEIF(B:B,I2,D:D)"
Range("L2").Resize(numData, 1).Formula = "=SUMIF(B:B,I2,E:E)"
Range("M2").Resize(numData, 1).Formula = "=SUMIF(B:B,I2,F:F)"
With Range("H2").Resize(numData, 6)
.Value = .Value
End With
Range("H2").Resize(numData, 1).NumberFormatLocal = Range("A2").NumberFormatLocal
End Sub
（QS） 2021/10/05(火) 02:57
やりたいことは、ピボットテーブルで一発ですね
VBAの学習のためにDictionaryをつかってみたいということなら それはそれでいいので、その方向で回答しますが、 結果を得るための最適解はピボットテーブルだと思います。
VBAの勉強用としてまず回答しますけど、 Dictionaryはキーとアイテムが一対一の対応なので、 アイテムとして複数の値を格納できるものを用意しないといけないです。 （´・ω・`） 2021/10/05(火) 09:18
前のスレッドでも書きましたが、私は、やはりピボットテーブルの利用を推奨します。 "合計"も"平均"も"データの個数"も、簡単に計算ができます。 一度作ってしまえば、データ更新処理（セル範囲を指示するだけです）し、 それすらマクロで簡単にできます。マクロなしで、自動指定する方法もあります。 ごりごりコードを書くのは、できるだけ避けたほうが無難です。
どうしてもということなら、以下のようにできます。 あえて、より簡単な例で説明させていただきます。 ご自分の例に応用してみてください。
売上高を データの個数で割った平均（意味があるかどうか知りませんが）を 計算する例です。
A列 B列 C D E F 1 品名 売上高 品名 平均 2 a 10 a 25 3 b 20 b 35 4 c 30 c 45 5 a 40 6 b 50 7 c 60
上記のA列、B列のデータをもとに、計算結果をE,F列に書き出しています。 参考にしてください。
Sub test()
Dim k As Long
Dim dic As Object
Dim a() ' a は arrayの頭1文字の積もり
Dim key
Dim s As String
Dim v As Double
Set dic = CreateObject("Scripting.Dictionary")
For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row
s = Cells(k, "A")
v = Cells(k, "B")
If Not dic.exists(s) Then
ReDim a(1 To 2)
a(1) = v
a(2) = 1
Else
a = dic(s)
a(1) = a(1) + v
a(2) = a(2) + 1
End If
dic(s) = a
Next
k = 1
For Each key In dic
k = k + 1
Cells(k, "E") = key
Cells(k, "F") = dic(key)(1) / dic(key)(2)
Next
End Sub
なお、
dic(s)(1) = dic(s)(1) + v
dic(s)(2) = dic(s)(2) + 1
などと書ければよいのですが、それはうまくいきません。
（γ） 2021/10/05(火) 09:50
連想配列の勉強の為ということなら、ご参考までに。
元のコードをなるべく活かすという方針でコーディングしてます。
γさんのコード例のように Item に配列を格納するという方法です。
配列は1行分のデータをすべて格納します。
平均を出すには、件数が必要ですが、配列の要素数を一つ増やしてそこに件数を格納します。
その件数を利用して平均をその都度、計算してます。
出力に関しては、
Items配列はジャグ配列（配列の配列）になりますので、Transposeを2回かけることで
二次元配列に変換して、セル範囲に直接出力するようにしてみました。
配列の最終列の件数は不要なので出力するときに列数を一つ減らしてます。
Sub 重複データを削除し合計を合算()
Dim myDic As Object
Dim myItem As Variant
Dim myList As Variant
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
'A列～F列のデータを配列に格納
myList = Range("A2", Range("A" & Rows.Count). _
End(xlUp)).Resize(, 6).Value
'連想配列にデータを格納
For i = 1 To UBound(myList, 1)
Dim a
'記号が空欄かチェック
If Not myList(i, 2) = Empty Then
If Not myDic.Exists(myList(i, 2)) Then
a = Array(myList(i, 1), myList(i, 2), myList(i, 3), _
myList(i, 4), myList(i, 5), myList(i, 6), 1)
myDic.Add Key:=myList(i, 2), _
Item:=a
Else
a = myDic(myList(i, 2))
a(3) = (a(3) * a(6) + myList(i, 4)) / (a(6) + 1) 'D列平均
a(6) = a(6) + 1 '件数
a(4) = a(4) + myList(i, 5) 'E列計
myDic(myList(i, 2)) = a
End If
End If
Next
myItem = myDic.Items
'ジャグ配列→二次元配列変換
myItem = WorksheetFunction.Transpose(WorksheetFunction.Transpose(myDic.Items))
'リストを出力
Cells(2, 8).Resize(UBound(myItem), UBound(myItem, 2) - 1).Value = myItem
'開放
Set myDic = Nothing
End Sub
（hatena） 2021/10/05(火) 14:32
こんばんは！ 皆さんの回答を参考にしながら自分流に書くとどうなるのかなと思って久しぶりに書いてみました。 結果は、こんな感じになりました。。。。 何かの参考になれば幸いです。。。。 おやすみなさいzzzzzzzzzzzzzzzzzzzzzzzzzz
Option Explicit
Sub 重複データを削除し合計を合算()
Dim myDic As Object
Dim myKey As Variant
Dim myItem As Variant
Dim myList As Variant
Dim x As Variant
Dim y As Variant
Dim z As Variant
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
'A列～F列のデータを配列に格納
myList = Range("A2", Range("A" & Rows.Count). _
End(xlUp)).Resize(, 6).Value
'連想配列にデータを格納
For i = 1 To UBound(myList, 1)
'記号が空欄かチェック
If Not myList(i, 2) = Empty Then
If Not myDic.Exists(myList(i, 2)) Then
'重複しない記号を取得
ReDim y(0)
y(0) = myList(i, 4)
myDic(myList(i, 2)) = Array(Application.Index(myList, i, 0), y)
Else
x = myDic(myList(i, 2))(0)
y = myDic(myList(i, 2))(1)
ReDim Preserve y(UBound(y) + 1)
y(UBound(y)) = myList(i, 4)
x(4) = Application.Average(y)
x(5) = x(5) + myList(i, 5)
myDic(myList(i, 2)) = Array(x, y)
End If
End If
Next
myItem = myDic.Items
ReDim z(UBound(myItem))
For i = LBound(myItem) To UBound(myItem)
z(i) = myItem(i)(0)
Next
'ジャグ配列→二次元配列変換
z = Application.Transpose(Application.Transpose(z))
'リストを出力
Cells(2, 8).Resize(UBound(z, 1), UBound(z, 2)).Value = z
'開放
Set myDic = Nothing
Erase myItem, myList, x, y, z
End Sub
（SoulMan） 2021/10/06(水) 00:28
平均計算のため、件数列が必要なので、前のコードではArray関数で配列を生成してましたが、ちょっと冗長だなと感じていました。
データを配列に格納するとき、1列分余分に格納して、その列を件数列にすればいいのでは、と思いつきました。
Sub 重複データを削除し合計を合算()
Dim myDic As Object
Dim myItem As Variant
Dim myList As Variant
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
'A列～F列のデータに、件数格納用にG列を加えた範囲を配列に格納
myList = Range("A2", Range("A" & Rows.Count). _
End(xlUp)).Resize(, 7).Value
'連想配列にデータを格納
For i = 1 To UBound(myList, 1)
Dim a
'記号が空欄かチェック
If Not myList(i, 2) = Empty Then
If Not myDic.Exists(myList(i, 2)) Then
a = Application.Index(myList, i, 0)
a(7) = 1
myDic.Add Key:=myList(i, 2), Item:=a
Else
a = myDic(myList(i, 2))
a(4) = (a(4) * a(7) + myList(i, 4)) / (a(7) + 1) 'D列平均
a(7) = a(7) + 1 '件数
a(5) = a(5) + myList(i, 5) 'E列計
myDic(myList(i, 2)) = a
End If
End If
Next
'Itemsのジャグ配列→二次元配列変換
myItem = Application.Transpose(Application.Transpose(myDic.Items))
'リストを出力
Cells(2, 8).Resize(UBound(myItem), UBound(myItem, 2) - 1).Value = myItem
'開放
Set myDic = Nothing
End Sub
ちょっとだけコードがスッキリしました。
（hatena） 2021/10/06(水) 09:18
じゃ、私も参加。 後出しなのでちょっと方法を変えて
----- クラスモジュール Class1 -------
Public Count As Long
Public Sum As Double
Public Property Get Average() As Variant
If Count <> 0 Then
Average = Sum / CDbl(Count)
Else
Average = CVErr(lErrDiv0)
End If
End Property
----- 標準モジュール -------
Sub sample()
Dim i As Long
Dim dic As Object
Dim key As Variant
Dim buf() As Variant
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
key = Cells(i, "C").Value
If Not dic.Exists(key) Then
dic.Add key, New Class1
End If
With dic(key)
.Count = .Count + 1
.Sum = .Sum + Cells(i, "D")
End With
Next
ReDim buf(1 To dic.Count, 1 To 2)
i = 1
For Each key In dic.keys
buf(i, 1) = key
buf(i, 2) = dic(key).Average
i = i + 1
Next
Cells(1, "J").Resize(dic.Count, 2).Value = buf
End Sub
（´・ω・`） 2021/10/06(水) 09:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.