VBA　DictionaryオブジェクトのItemについての質問です。

Question

エクセル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ペコッ

cj_mover · Accepted Answer

こんにち　わ
遅くなってすみません。さっそくですが
まずは説明の為の実験から話をすすめさせて下さい。

ご提示のソースコードで、
myDic の設定が終わった後の行、Set ns =～の行の直前に、
以下、４行を挿入して、
　Dim Arr(1) As Variant
　Arr(0) = myDic.Keys
　Arr(1) = myDic.Items
　Stop
実行後、Stop状態でローカルウィンドウを眺めて見ると、

[-] Arr　◇ myDic
├[-] Arr(0)　◇ myDic.Keys
│├[-] Arr(0)(0)　◇ myDic.Keys(0)
│├[-] Arr(0)(1)　◇ myDic.Keys(1)
│├[-] Arr(0)(2)　◇ myDic.Keys(2)
│├ ・
│└ ・
└[-] Arr(1)　◇ myDic.Items
　├[-] Arr(1)(0)　◇ myDic.Items(0)
　│├[-] Arr(1)(0)(0)　◇ myDic.Items(0)(0)
　│├[-] Arr(1)(0)(1)　◇ myDic.Items(0)(1)
　│├[-] Arr(1)(0)(2)　◇ myDic.Items(0)(2)
　│├ ・
　│└ ・
　├[+] Arr(1)(1)　◇ myDic.Items(1)
　├[+] Arr(1)(2)　◇ myDic.Items(2)
　├ ・
　└ ・

こんな樹形図が現れます。
myDicの中身を、ひとつのVariant変数Arrに喩えたら。という話ですが、
　Arrは一次元配列で、
　Arrの要素Arr(0)、Arr(1)は、それぞれ一次元配列、
　Arr(1)の要素Arr(1)(0 To X)は、それぞれ一次元配列、
　Arr(1)(0 To X)の要素はArr(1)(0 To X)(0 To Y)、
一次元多段階配列で階層構造がみえてきます。
ご提示のソースコードをみて、頭の中のイメージで
上のような樹形図が浮かび、窮屈な（かなり難しそうな）印象を受けました。
（In/Outどちらかが、樹形図様なら、自然なんでしょうけれど。）
Dictionaryで扱っているとそうは感じないのですが実際は結構複雑です。
配列の中身が配列っていうのを、二段階配列なんて呼びますけれど、
二次元配列より、難易度（扱い難さ）は上。という認識でいます。
『セル範囲→二次元配列→セル範囲』二次元で統一したら、
楽なんじゃないかな？と思って前稿を書いてみたのですが、
反ってわかり難い、ということのようですね。
それはそれで、とても感覚的なことだと思うので、
重ねて意見をおすつもりはありません。
ややっこしく感じない方法を選べばよいのです。
でもまぁ無駄になる話でもないつもりなので、時間のある時にでも、
考えて頂ければ、幸いです。

>ただ、１次元配列では配列インデックスは0から、
>二次元配列は１からだと思っていたところ、
>二次元でも0からに出来るんですね、
>しかも次元ごとに０と１を組み合わせるなんてことも！

0でも1でも、それ以上でも、自分で定義すればいいです。

　Option Base 1
とモジュールの宣言部に書いておけば（機会は少ないですが）、
　Dim A(5, 4)
は、A(1 To 5, 1 To 4)

　Option Base 0
（デフォルトでBase 0なので通常は省略しますが）ならば、
　Dim A(5, 4)
は、A(0 To 5, 0 To 4)

　どちらの場合でも
　Dim A(2 To 5, 3 To 4)
は、A(2 To 5, 3 To 4)

（以上は自分で定義した場合、以下はそれ以外）

　Option Base によらず、どちらの場合でも
　vA = Range("any").Value
は、1ベース

　v = Split("A B")
や、
　Lbound(myDic.keys)
は、0ベース、

ちょっとややこしいけど、とりあえず（myDic.keysは別としても）
これ位の場合分けを覚えておけば、困ることは少ないと思います。
使い慣れない関数、メソッドやプロパティから配列を変数に受ける時は、
ローカルウィンドウなど（できればヘルプ）で、確認すればよいです。

　vA = Range("any").Value、セル範囲の値（配列）の場合、
（行数や列数がひとつでも）必ず1ベースの二次元配列を返す。このことを、
少し混乱して覚えていたのではないでしょうか。
次元数でBaseが決まるのではなく、関数、メソッドやプロパティなど、
で決まります。

>また、ReDim Preserve vAP～で出力用配列を再定義したのは、
>当初の vAPが、Keyを取り込んだ１次元配列を、
>出力用に2次元に変換するためですね？
(後の補足欄のコメント)
>でもDictionaryって一次元配列ですよね？どうしてなんでしょう？

>>vAP = Application.Transpose(myDic.Keys) ' 出力用配列にKeysを渡す
結果は、vAP(1 To c, 1 To 1)　で、この時点で、二次元になってます。
Application.Transpose()の機能によって二次元配列に変換されます。
（cはmyDic.Keys.Countと同値）
>>ReDim Preserve vAP(1 To c, 0 To lC) ' 出力用配列を再定義
１）vAP(every, 1)にあった値は、vAP(every, 0)に移ります。
LBound(,2)がLBound(,2)に移るって考えればいいと思います。
２）vAP(1 To c, 0 To lC)で、
出力側のセル範囲にサイズを合わせています
(0ベースですから、実際の列番号とは相対です)。
vAP(every, 0)は、Keys相当。
vAP(every, 1 To lC)は、計算の為の作業スペースであり、
最終的には求める値（出力する配列）にもなる、ということです。


>...書き換えてみましたが、同じでことすね？

結果は、全く同じです。
その場合は最初にlCを設定する時の-1を消して、全体を合わせて書けば、
文字数(演算回数)もほぼ(j - 1の部分以外)同じになります。
取得した配列vAVのインデックスを基準にするか、
シート上の列番号を基準にするか、の違いだけです。
工夫の余地はあると思います。

>縦ヨコでインデックスが異なる

>>　vAP(lB, j) = vAP(lB, j) + vAV(i, j)
iは、元の(重複を含む)表の行を上から下に走る。
元の表のi行めにあるキーとなる(1列めの)文字列は
myDic.KeysのlB番め(1から数えて)にあるから、
■出力側のlB行め(キーに対応したユニークな位置)の、
■j列(元の表、出力側の表、ともに2列めが1となる相対位置)の
■【vAP(lB, j)】
　に、
◆元の(重複を含む)表のi行めの、
◆j列(元の表、出力側の表、ともに2列めが1となる相対位置)の
◆【vAV(i, j)】
　を
　加算(連結)する
うーん、、、うまく伝わるかなぁ。

前後しましたが、
>> つまりテーブル操作をDictでやるという趣旨でしょうか？
>「テーブル操作」って何でしょう？のレベルなものですから・・・。
これは答えるの難しいですね。
私自身が用語を未整理なまま使ってしまいました。すみません。
そうでなくても難しいのですけれど。
「テーブル」という表現をやめて「表」でいうと、
「ある表から、もうひとつの表を参照して、新たな表を作る。」
私が書いたものでは、
myDicは、Key文字列と対応するID(インデックス)とでひとつの「表」
（よくLOOKUP等の関数で参照先セル範囲にあるリストのよう）になっていて、
元のシートにある「表」とをすり合わせて、
新しいシートに新しい「表」を作っています。
（ここからはまた、感覚的なのですが、）私にはご提示のソースコードが、
上に書いたような意味で同じように"見える"ということです。
拡大解釈をすれば、データベースにとってのクエリに似たような処理、
ですよね。それをDictを使って処理するのは目から鱗ですね。
ってな感じのことを言わんとしたのですが、あまり深く考えないでおいて
貰えると、私も幸せになれるのですが(^^;)。

自己レス
>>文字列の連結に+演算子を使うことについては、
>>Variant変数同士ですから、ま、いいかな、と。
ダメじゃん。せいぜい、
　Variant変数同士ですし、条件が合うなら、ま、いいかな、とも思います。
あと、
>>勝手に.CurrentRegionにしてますが、
　元のセル範囲の行数を取得することなく実現することで、
　For Each で回すメリットを強調したかったもので、、、。

全体に書き足りないこと書きすぎていることが目立ってわかり難くなって
ました(反省)。いつも、すみません。

mitarashi · Answer

#3です。具体例を話の種に載せておきます。
Sub ItemsTest2()
    Dim myDic As Object, ns As Worksheet
    Dim c As Range, cc As Range, i As Integer
    Dim myRange() As Range
    Dim j As Long
    Dim myArea As Range, myRow As Range
    Dim sum1 As Long, sum2 As Long, sum3 As Long, sum4 As String
    
    j = 1
    Set myDic = CreateObject("Scripting.Dictionary") 
    For Each c In Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
        If Not myDic.exists(c.Value) Then
            ReDim Preserve myRange(1 To j)
            Set myRange(j) = c.Offset(0, 1).Resize(1, 4)
            myDic.add c.Value, myRange(j)
            j = j + 1
        Else
            Set myDic(c.Value) = Union(myDic(c.Value), c.Offset(0, 1).Resize(1, 4))
        End If
    Next c
    Set ns = Worksheets.add(After:=ActiveSheet)
    ns.Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys)
    For Each cc In ns.Range("A1:A" & myDic.Count)
        sum1 = 0: sum2 = 0: sum3 = 0: sum4 = ""
'ここの足し算をワークシート関数のSUMとかで出来ると面白かったのですが...
        For Each myArea In myDic.Item(cc.Value).Areas
            For Each myRow In myArea.Rows
                sum1 = sum1 + myRow.Cells(1)
                sum2 = sum2 + myRow.Cells(2)
                sum3 = sum3 + myRow.Cells(3)
                sum4 = sum4 & myRow.Cells(4)
            Next myRow
        Next myArea
        cc.Offset(0, 1).Value = sum1
        cc.Offset(0, 2).Value = sum2
        cc.Offset(0, 3).Value = sum3
        cc.Offset(0, 4).Value = sum4
    Next
End Sub

cj_mover · Answer

こんにち わ

このソース面白いですね。
Dictオブジェクトは滅多に使わない私ですが、
これ、つまりテーブル操作をDictでやるという趣旨でしょうか？
Itemに配列を代入するのって、確かに面白いのですけれど、
反って窮屈になっているようにも感じますね。
仮にDictに拘らなければ、より簡単な方法もありそうですが、
研究課題なのかと理解しています。
Dictの主な役割はユニーク抽出、
言ってみれば主キーを扱うマスターテーブルでもある訳で、
もうひとつのデータテーブル（配列）とで
リレーショナルな感じで書くのも、あり、かな？と書いてみました。

で、配列の扱いに主眼をおいてのレスですが、
以前にも少し書きましたが、流れとして、
　セル範囲の値をVariant配列変数へ一括で受けて、
　（メモリ上で処理して）
　出力用のVariant配列変数の値をセル範囲へ一括で出力。
セル範囲に触るのは、入口、出口で、一度ずつ、というのが、（基本的に）
配列変数を扱うダイナミックさでもあり、合理的な方法だと思います
（物理的環境(主にメモリー容量)の変化に連れ、今日的な意味も含めて）。
今回は、
IN側は解りやすくする為に、２回(１回でも書けるけど)にして、
OUT側は Preserve キーワードの使用例も兼ねて、１回にしました。
Variant配列を、For Each で回すメリットを示す意図も込めています。
もっと、大雑把にいうと、値に関しては、
Rangeで回すより、変数を回した方が有利な面が多い、ということなのです。

全体のロジックとしては、
自分ならRecordSetかバックグラウンドでEcelシートかOWCSpreadSheetとか。
私がDictを使うならば、こんな感じってだけですから、
Dict遣い－の方からみれば違和感あるかも、です。
簡単にしたい、という課題なら（むしろ私の得意ですが）、
大ハズシかも、、、。

もうひとつ、
Arrayを使う以上は、列の数(フィールド数)を決め打ちしないとならない、
というのが、今回の質問のきっかけなのではないかと思いました。
実際は、ReDimしてからループすれば、直接の答えになるのかな、
とも考えたのですが、むしろ可読性が落ちるようでしたので、
題意からは少し離れた話を選びました。
代わりに列数=Unkownでも動くようになってるです。

文字列の連結に+演算子を使うことについては、
Variant変数同士ですから、ま、いいかな、と。
勝手に.CurrentRegionにしてますが、これは、ご愛嬌ってことで。

Sub DicArrRelational()
Dim c As Long, i As Long, j As Long, lC As Long, lB As Long
Dim myDic As Object, ns As Worksheet
Dim vAK, vAV, vAP, v
With Cells(1).CurrentRegion.Columns
　　vAK = .Item(1).Value ' Keys範囲を一括でVariant配列に
　　lC = .Count - 1 ' 値範囲の列数
　　vAV = .Item(2).Resize(, lC).Value ' 値範囲を一括でVariant配列に
End With

Set myDic = CreateObject("Scripting.Dictionary")
For Each v In vAK ' ユニークKeys抽出
　　If Not myDic.Exists(v) Then 'myDicになければ
　　　　c = c + 1& ' Keysの数(インデックス)
　　　　myDic.Add v, c ' インデックスのみ設定
　　End If
Next v

vAP = Application.Transpose(myDic.Keys) ' 出力用配列にKeysを渡す
ReDim Preserve vAP(1 To c, 0 To lC) ' 出力用配列を再定義

For Each v In vAK ' Key毎、値フィールド毎の集計を出力用配列に
　　i = i + 1&
　　lB = myDic(v) ' Keysに対応したインデックス
　　For j = 1& To lC
　　　　vAP(lB, j) = vAP(lB, j) + vAV(i, j)
　　Next j
Next v

Set ns = Worksheets.Add(After:=ActiveSheet) 'シートを追加
ns.Cells(1).Resize(c, lC + 1).Value = vAP ' 出力用配列を一括出力

Set myDic = Nothing: Set ns = Nothing
End Sub

NNAQ · Answer

数値を加算する部分は、エクセルの[統合]という機能で、
簡単に一発で出来ますね。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/tougou.html
文字列の結合は、ループさせないとだめでしょうねえ。
Dictionaryの Item は文字列のみに使い、加算は[統合]してしまうのはどうでしょうか。

Sub macro()
Dim myDic As Object, mySh As Worksheet
Dim rng As Range, c As Range
Set myDic = CreateObject("Scripting.Dictionary")
Set mySh = ActiveSheet
Set rng = mySh.Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
For Each c In rng
    With c
        myDic.Item(.Value) = myDic.Item(.Value) & .Offset(0, 4).Value
    End With
Next c
With Worksheets.Add(After:=mySh)
    .Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys)
    .Range("E1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.items)
    .Range("A1:A" & myDic.Count).Consolidate _
        Sources:=mySh.Name & "!" & rng.Resize(, 4).Address(ReferenceStyle:=xlR1C1), _
        Function:=xlSum, TopRow:=False, LeftColumn:=True
End With
End Sub

mitarashi · Answer

itemをRange型にして、該当するRangeをUnionでくっつけて保管する方法が考えられますが、Application.Worksheetfunction.sumで、簡単に計算するという訳にはいかないようで、結局後でArea毎、Row毎にループを回して処理しないといけないので、「スッキリ」しません。

n-jun · Answer

・重複のないキーを書き出す。
・SUMIF関数の数式を入れる。
・数式を値に変更する。

キーが１つならこんな方法も。
⇒Ｅ列が足す訳じゃないんでしょうけど、Ｂ～Ｅ列が加算していくとした場合に限ります。

fujillin · Answer

ロジックはほとんど同じですが、シートに直接書いてしまう方法です。
直接書くので、配列やDictionaryは使用していません。
重複する場合の加算にループを利用しているのも同じです。

何かの参考にでもなれば…
Sub test()
Dim st As Worksheet, ns As Worksheet
Dim c As Range, cc As Range, rw As Long, i As Integer

Set st = ActiveSheet
Set ns = Worksheets.Add(After:=st)
rw = 1

For Each c In st.Range(st.Cells(1, 1), st.Cells(Rows.Count, 1).End(xlUp))
　Set cc = ns.Columns(1).Find(What:=c.Value, Lookat:=xlWhole)
　If cc Is Nothing Then
　　ns.Cells(rw, 1).Resize(1, 5).Value = c.Resize(1, 5).Value
　　rw = rw + 1
　Else
　　For i = 1 To 4
　　　cc.Offset(, i).Value = cc.Offset(, i).Value + c.Offset(, i).Value
　　Next i
　End If
Next c
End Sub

個人的には、数値も文字も同じループで「+」演算処理するのは気持ちわるいので、i=4の場合は「&」にしてしまうとかするかも。
（結果は同じですけど、Ｅ列に入っている内容のチェックを一切行っていないので、コード上では文字だという保証がないので）

VBA DictionaryオブジェクトのItemについての質問です。

こんにち わ

#3です。

こんにち わ

この回答への補足

数値を加算する部分は、エクセルの[統合]という機能で、

・重複のないキーを書き出す。

ロジックはほとんど同じですが、シートに直接書いてしまう方法です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

VBA　DictionaryオブジェクトのItemについての質問です。

こんにち　わ

こんにちわ