VBA DictionaryオブジェクトのItemについての質問です。
エクセル2000です。
A列からE列までの1行から最終行不特定の表があります。
A列はすべて文字列で、B~Gは数値、E列は文字列です。
A列の文字列には重複があります。
この表を別シートにA列の重複がない表として作成したいと思います。
その際、列が重複する場合にはB~G列は合計数値、E列は文字列を結合させます。
Dictionaryオブジェクトを用い、A列データをKey、B~E列データを配列でItemとして下記のコードを書きました。
このコードで目的は達成しました。
質問はKeyが重複する場合、B~E列のデータを配列として取り込んだItemに次のB~E列のデータを加算あるいは結合する方法の簡略化です。
このコードではItem内の配列データを、さらに配列変数のmyArに代入して、要素ごとにForNextで回しましたが、配列変数にわざわざ代入しなくとも出来る方法があるかどうかが知りたいのです。
あるいはまったく別な方法でもかまいません。
ご教示いただければ幸いです。
Sub ItemsTest()
Dim myDic As Object, ns As Worksheet '変数宣言
Dim c As Range, cc As Range, i As Integer
Dim myAr
Set myDic = CreateObject("Scripting.Dictionary") 'myDicを用意
For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp)) 'A列の各データについて
If Not myDic.exists(c.Value) Then 'myDicになければ
myDic.Add c.Value, Array(c.Offset(0, 1).Value, c.Offset(0, 2).Value, c.Offset(0, 3).Value, c.Offset(0, 4).Value) '追加しB~E列データを配列でItemに
Else 'myDicにあれば
myAr = myDic(c.Value) 'Itemを配列myArに
For i = LBound(myAr) To UBound(myAr)
myAr(i) = myAr(i) + c.Offset(0, i + 1).Value '配列の要素ごとに加算
Next i
myDic(c.Value) = myAr '配列myArをItemにもどす
End If
Next c '繰り返し
Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
ns.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) 'A列にKeyデータ転記
For Each cc In ns.Range("A1:A" & myDic.Count)
cc.Offset(0, 1).Resize(, UBound(myAr) + 1).Value = myDic.Item(cc.Value) 'B~E列にItemデータ転記
Next
End Sub
(o。_。)oペコッ
お礼
参考になりました! 早速トライしてみます。 ありがとうございました!!