[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『配列 の使い方、Dictionaryの使い方』（tata）
投稿
[[20170722103510]] 『vba Findの使い方 見つからなかったときの返り値』（tata）
について...
からの派生です
|[A] |[B] |[C] |[D]|[E]|[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M]
[1]|名前入力欄|月 |件数| | |個人名|１月|２月|３月|４月|５月|６月|７月
[2]|い |３月| 4| | |あ | | | | | | |
[3]|あ |３月| 6| | | | | | | | | |
[4]|う |３月| 8| | | | | | | | | |
[5]|あ |４月| 2| | | | | | | | | |
[6]|い |４月| 9| | | | | | | | | |
[7]|か |４月| 7| | | | | | | | | |
[8]|う |７月| 3| | | | | | | | | |
[9]|あ |７月| 5| | | | | | | | | |
A列からC列の元データについて
F列に名前があればその行に
F列に名前がなければ一番下の行に
その月の件数を転記
今までの流れで、力技で解決はしたものの、
今回のケースは １）配列で一括出力 ２）連想配列で重複チェック を使うと、格段に早くなる という事を教えていただきました。
配列の使い方がわからずに、教えていただいている流れです。
課題：
今回の元データ配列をループ処理して、「か」が最初に出現した月をmsgboxで表示させてください。
＜ 使用 Excel：Excel2007、使用 OS：Windows10 ＞
Sub test8()
Dim dic As Object
Dim r As Range
Set dic = CreateObject("Scripting.DIctionary")
For Each r In Range("A2:A9")
If dic.exists(r.Value) Then
'すでに登録されていた場合の処理
Else
dic.Add Key:=r.Value, Item:=r.Row
End If
Next r
MsgBox "「う」が最初に出現した行は" & dic.Item("う") & "行目です"
Set dic = Nothing
End Sub
１・元データを配列に格納
２・上記例を参考に、dicに重複を削除しながら入れる
（tata） 2017/07/23(日) 09:50
解説をお願いします。
Sub test102()
Dim 元データ配列 As Variant
Dim dic As Object
Dim r As Variant
Set dic = CreateObject("Scripting.DIctionary")
元データ配列 = Range("A2", Cells(Rows.Count, "C").End(xlUp)).Value
For Each r In 元データ配列
If dic.exists(r) Then
'すでに登録されていた場合の処理
Else
dic.Add Key:=r, Item:=r '例示ではkeyに人名を、Itemに行数を格納した
'単に例示から.value, .rowを外すと い、あ、う、かの後は３月、４月、７月、4,6,8,2…と登録されていく
'keyは人名、Itemは月になるようにしなければならない？
End If
Next r
MsgBox "「か」が最初に出現した行は" & dic.Item("か") & "行目です" '.Item()は"か"に対応するメンバを返す
Set dic = Nothing
End Sub
（tata） 2017/07/23(日) 10:24
>「か」が最初に出現した月を得ようとするには、
Sub test102()
Dim 元データ配列 As Variant
Dim dic As Object
Dim i As Long
Set dic = CreateObject("Scripting.DIctionary")
元データ配列 = Range("A2", Cells(Rows.Count, "C").End(xlUp)).Value
For i = 1 To UBound(元データ配列, 1)
If Not dic.exists(元データ配列(i, 1)) Then dic.Add Key:=元データ配列(i, 1), Item:=元データ配列(i, 2)
'最初に出現したA列ユニーク値にのみB列データを格納する。
Next
If dic.exists("か") Then
MsgBox "「か」が最初に出現した月は" & dic.Item("か") & "月です" '.Item()は"か"に対応するメンバを返す
Else
MsgBox "「か」は存在しません"
End If
Set dic = Nothing
End Sub
（ seiya） 2017/07/23(日) 10:45
先生が来たので何も言うことないっす。 返事遅くてすみません
ここまで来たら、あとは出力用の配列のサイズをReDimで指定して、 データを入れていくのですが、出先なのでちゃんと説明できません やはり、明日になりそうです
申し訳ない （稲葉） 2017/07/23(日) 11:16
氏名別、月別の件数表を作りたい、ということでしょうから、
dictionaryを利用するのであれば、
keyは氏名、 Itemには記入先の行番号
を持たせるとよいのではないですか？
（dicになければ、dic(s) = dic.count + 1 などと）
でもこれって、普通はピボットテーブルに任せるところかもしれませんね。
（γ） 2017/07/23(日) 12:09
（γ）さん
大本の質問者さんには、私も最初ピボットテーブル提案したのですが、 元のデータがデータベース形式で存在せず、 7月まではすでに件数表に手入力済み 8月から楽に入力したい 多分入力済みの様式も崩したくない？ というご要望だったので、ピボットテーブルは撥ねられたんですよね。
そこからの派生で、自分自身の勉強として、 Findで検索して、一致した場所に転記 というのを考えたんですが、Find以外の良いやり方もある、とご助言頂いたことで今に至ります。
＞keyは氏名、 Itemには記入先の行番号 ＞を持たせるとよいのではないですか？ ＞（dicになければ、dic(s) = dic.count + 1 などと） すみません、dic(s) = dic.count + 1 ちょっと理解ができていないので、 もう少し基礎から調べながら考えてみます。
（稲葉）さん
長い間付き合って頂いてすみません。 来週末まで基礎調べながら考えてみます。
Sub test103()
Dim 元データ配列 As Variant
Dim 出力配列 As Variant
Dim dic As Object 'Dictionary
Dim i As Long '元データ配列の行
Dim j As Long '出力配列行
Set dic = CreateObject("Scripting.DIctionary")
元データ配列 = Range("A2", Cells(Rows.Count, "C").End(xlUp)).Value
For i = 1 To UBound(元データ配列, 1)
If Not dic.exists(元データ配列(i, 1)) Then dic.Add Key:=元データ配列(i, 1), Item:=元データ配列(i, 2)
Next i
'出力用の配列のサイズをReDimで指定
ReDim 出力配列(1 To dic.Count, 1 To 13)
'データを入れていく 考え中
For i = 1 To UBound(元データ配列, 1)
If 元データ配列(i, 1).Value = 出力配列(j, 1).Value Then
Else
End If
Next
Set dic = Nothing
End Sub
（tata） 2017/07/23(日) 12:39
＞dic(s) = dic.count + 1 ちょっと理解ができていないので、
dic.countは、その時に既にdicに登録済みの人数です。
それに1を加算した行（実際にはいったん配列に保持するのですかね）
に書き込むことにする、ということです。
色々事情があるようですね。
以下、参考までにお聞きします。
＞元のデータがデータベース形式で存在せず、
今のA1:C9はデータベース形式ではないのですか？
＞ 8月から楽に入力したい
楽に入力とはどういう形式のことですか？
でもって、今質問されているのは、7月までの入力のことですか？
それとも、8月以降の話を質問されているのですか？
（γ） 2017/07/23(日) 13:02
γさん 私の教え方が下手で、最初行番号をいれてもらう予定でいましたが 難しそうだったので、最初に出てくる月は？という比較的簡単な課題を 出しました
順番に説明したかったので、まずはdictionaryの使い方を、と 思った次第です。
for i = 1 to ubound(元データ,1)
if not dic.exists(元データ(i, 1)) then
dic.add 元データ(i, 1), dic.count + 1
出力配列(元データ(i, 1),match(元データ(i, 2),range("f1:r1"),false)) = 元データ(i, 3)
end if
next i
という流れに持っていく予定でした
（稲葉） 2017/07/23(日) 13:14
（γ） 2017/07/23(日) 13:25
＞色々事情があるようですね。 ＞今のA1:C9はデータベース形式ではないのですか？ ＞楽に入力とはどういう形式 説明不足で申し訳ないです。 そのあたりは大本の質問者さんの問題で、
現在はデータベース形式で入力し、単純に配列の使い方の勉強です。
'---ここから大本の質問者さんの内容---
大本の質問者さんは、以下のデータを提示して
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M]
[1]|個人名|１月|２月|３月|４月|５月|６月|７月|８月|９月|１０月|１１月|１２月
[2]|あ | 2| | 1| 1| | | | | | | |
[3]|い | | 4| 3| 3| 1| | | | | | |
[4]|う | 3| | | 2| | | | | | | |
「入力の際、
個人名が何行目に有るか探して入力するのが大変だ
毎月来店するとは限らず、新規の人もある
例えば、別に入力欄を作って、 氏名と月と件数を入れれば該当者の該当月にその件数が自動入力され、 該当者がない場合空欄にそのデータが自動入力される 方法はないか」 という相談でした。
大本の質問者さんに、
入力シート
|[A] |[B]|[C]
[1] |氏名|月 |件数
[2] |あ | 1| 2
[3] |う | 1| 3
[4] |い | 2| 4
[5] |あ | 3| 1
[6] |い | 3| 3
[7] |あ | 4| 1
[8] |い | 4| 3
[9] |う | 4| 2
[10]|い | 5| 1
「↑のような形で入力すれば、ピボットテーブル使えて『楽』なのでは？」と提案したのですが、
質問者さんは 「全件入力したデータを後で集計するのではなく 既に来店している人の行の該当月のセルに件数が自動で入力されるといったしくみができないか」 というご要望で、
既に7月までのデータは集計済みのデータしか無く、 8月からのデータを紙媒体で所有している状態でした。
稲葉さんが 「7月までのデータは集計表そのまま。 8月からのデータはA:C列にデータベース形式入力することで転記される関数」 を紹介されて、質問者さんの問題は解決しました。
'---ここから私の問題--- 私は、稲葉さん同様に、 8月からのA:C列データをマクロで転記するのを練習がてら作ってみたのですが、
私の組んだマクロは、いちいちFindで氏名を検索しており、効率が悪い。 配列を使えば速いとの指摘。
'---ここから現在の質問状況--- ＞今質問されているのは、7月までの入力のことですか？ ＞それとも、8月以降の話を質問されているのですか？
今の質問状況は、大本の質問者さんの状況は無視して、
1月から全てのデータがデータベース形式でA:C行に入力済み の想定で 配列の扱い方の練習 と考えています
使い方を学べば応用で最後の出力範囲を8月にずらせばできるかな、と。
（tata） 2017/07/23(日) 13:39
辞書は有用な道具です。
とりわけ、key item の選択が大事です。
頑張ってください。私はこれで。
（γ） 2017/07/23(日) 14:18
Sub test104()
Dim 元データ配列 As Variant
Dim 出力配列 As Variant
Dim dic As Object 'Dictionary
Dim i As Long '元データ配列の行
Dim j As Long '出力配列 行
Dim m As Long '出力配列 列
Set dic = CreateObject("Scripting.DIctionary")
元データ配列 = Range("A2", Cells(Rows.Count, "C").End(xlUp)).Value
'辞書を準備。重複のない人名リスト(key)と、出力すべき行番号(item)
For i = 1 To UBound(元データ配列, 1)
If Not dic.exists(元データ配列(i, 1)) Then dic.Add Key:=元データ配列(i, 1), Item:=dic.Count + 1
Next i
'出力用の配列のサイズをReDimで指定
ReDim 出力配列(1 To dic.Count, 1 To 13)
'元データ配列(i, 1)の値(人名)を、出力配列(j, 1)に格納する
'元データ配列(i, 3)の値(件数)を、出力配列(j, m)に格納する
'j の値は、辞書と照らしてdicのItem
'm の値は、元データ配列(i, 2)とRange("F1:R1")のMatch返り値
For i = 1 To UBound(元データ配列, 1)
j = dic.Item(元データ配列(i, 1))
m = WorksheetFunction.Match(元データ配列(i, 2), Range("F1:R1"), False)
出力配列(j, 1) = 元データ配列(i, 1) '何度も同じ場所に書き込み無駄。条件分岐で外に出すべき？
出力配列(j, m) = 元データ配列(i, 3)
Next i
Cells(2, "F").Resize(dic.Count, 13).Value = 出力配列
Set dic = Nothing
End Sub
（稲葉）さん 2017/07/23(日) 13:14 の例示だと、
dicを作成すると同時に実施してる感じでしょうか？
理解が追いつきません。
（tata） 2017/07/23(日) 16:59
遅くなりました 自分でできたなら、いいじゃないですか！ 人の真似するだけじゃなくて、結果が同じで処理の負担が たいして違わないのであれば、私は人によってコードが違ってもいいと思いますよ
http://yamagata.int21h.jp/tool/testdata/
参考リンク先でテストデータで400人分の名前をつくって、 ひと月350件になるようにコピーして最初に自分で作ったコードと、今回できた コードで比較してみて下さい
＞使い方を学べば応用で最後の出力範囲を8月にずらせばできるかな、と。 こちらは、今度出力済みの範囲を先にdicに取り込んでから 今の処理をすれば良いので、簡単に応用できると思いますよ 出力範囲を変えず、データを取り込んでから同じデータを書き戻す感じですね
あまり私の助け要らないみたいですねぇ （稲葉） 2017/07/23(日) 22:52
私が最初に導こうとしていたコードが以下になります。 tataさんのほうが丁寧で、分かり易いですね！
Sub test10()
Dim tbl As Variant '//tbl=氏名;月;件数
tbl = Range("A2", Cells(Rows.Count, "C").End(xlUp)).Value
Dim OPr As Range '//出力先のヘッダー
Set OPr = Range("F1:R1")
Dim dic As Object '//key=氏名、Item=出力先の行数
Set dic = CreateObject("Scripting.Dictionary")
Dim ans As Variant '//出力データ
ReDim ans(1 To UBound(tbl, 1), 1 To OPr.Count)
Dim Idx As Long '//tblの行にあたるインデックス
Dim ID As String '//氏名
Dim mon As Long '//月の列番号（Fから数えて）
For Idx = 1 To UBound(tbl, 1)
ID = tbl(Idx, 1)
mon = Application.WorksheetFunction.Match(tbl(Idx, 2), OPr, False)
If Not dic.exists(ID) Then
dic.Add Key:=ID, Item:=dic.Count + 1
ans(dic.Item(ID), 1) = ID
End If
ans(dic.Item(ID), mon) = tbl(Idx, 3)
Next Idx
'//出力 一回データをクリアしてから、新しく入れなおす。
With OPr.Offset(1)
.Resize(Cells(Rows.Count, OPr.Column).End(xlUp).Row).ClearContents
.Resize(dic.Count).Value = ans
End With
Set OPr = Nothing
Set dic = Nothing
End Sub
特に ＞'出力用の配列のサイズをReDimで指定 ＞ReDim 出力配列(1 To dic.Count, 1 To 13) この部分。私は面倒なので、大きく確保してから出力時に必要数に丸めました。
もし直すとしたら、
＞ReDim 出力配列(1 To dic.Count, 1 To 13)
~~
この13くらいです。
いわゆるマジックナンバーと呼ばれ、作ったときは意味が分かったけど、後で読むとなんで13だっけ？
となる数字です。
ここを、Range("F1:R1").Countなどに置き換えると、列サイズを指定しているのだなと後から読んで分かりやすくなります。
＞出力配列(j, 1) = 元データ配列(i, 1) '何度も同じ場所に書き込み無駄。条件分岐で外に出すべき？ ここに関しては、コストが条件分岐＞データの出し入れになるので、そのままでもよいかと。
一通り終わったのでいったん区切りますが、もう少しお伝えしたいことがあります。 （Dictionaryの省略方法や、集計にも便利に使えるという点） もうお腹いっぱいということであれば、これにて退散いたします。 （稲葉） 2017/07/24(月) 10:18
今まで私
Dim i 'って、「変数を宣言する」だと思ってたんですけど、もしかして、
'本当は「(n次元の)配列を宣言する」って意味だったんですかね？
DimensionのDim？
Dim i '0次元の配列(原点の1点のみ)
Dim i(x) '1次元の配列(x軸上)
Dim i(y, x) '2次元の配列(xy平面上)
Dim i(y, x, z) '3次元の配列(xyz空間)
Dim i(y, x, z, t) '4次元の配列(xyzと直交する軸t追加)…
閑話休題
＞あまり私の助け要らないみたいですねぇ とんでもない！全部皆さんの例示の真似ですよ
＞自分で作ったコードと、今回できたコードで比較 テストデータ 400人分の名前 ひと月350件 計4200件で処理
よそから検索してお借りした下記実行時間測定コードで挟み込み
Dim StartTime As Variant, StopTime As Variant
StartTime = Time
処理
StopTime = Time
StopTime = StopTime - StartTime
MsgBox "所要時間は" & Minute(StopTime) & "分" & _
Second(StopTime) & "秒 でした"
自分で作ったFind使用コード 0分5秒 教えて頂いて作った今回コード 0分0秒
小数点以下表示されていませんが、0秒ということは0.5秒未満なので、 最低でも10倍以上の差があるってことですね！！
サンプルコード(模範解答)、ありがとうございます。 ＞出力用の配列のサイズ ＞大きく確保してから出力時に必要数に丸め ピッタリのサイズを用意する必要はなかったんですね。 そうすると、 ReDim 出力配列(1 To dic.Count, ) のdic.Countを正しい数得る目的での 予め辞書を完成させるための1ループ回しておく必要が無い→ループ回数が1回減る、と。
＞マジックナンバー ご指導ありがとうございます。慣れるようにします。 (どうしてもその場限り、場当たり的にやっちゃう事が多々…)
＞コストが条件分岐＞データ 配列同士だとそんな速度になったりするんですね。
＞一通り終わったのでいったん区切り ここまでありがとうございました。 応用の 出力済みの範囲を先にdicに取込 等はまた使う時に躓いたらお聞きするかもしれません。
Dictionaryの省略方法や、集計
のお話、お聞かせ願えますでしょうか。 （tata） 2017/07/24(月) 20:29
なんだか、合ってるみたいですよ 私は気にしたことありませんでした（汗）
＞ピッタリのサイズを用意する必要はなかったんですね そうなのですが、大きくもつ必要も無いんですよね 本来はReDim Preserveを使って値を維持したまま、動的に 要素を増やしていくべきなのでしょうね ReDimで要素を増やせるのは最後の次元だけなので、行方向に 増える場合はTransposeしたりと、今回の説明がぼやけそうだったので 省略しました
sub test20
Dim a(1 to 1,1 to 1) as long
ReDim preserve a(1 to 1,1 to 2)'列に当たる二次元目は最後の次元なので拡張できる
ReDim preserve a(1 to 2,1 to 2)'行に当たる一次元目はエラーになる
end sub
で、増やすにはどうするかというと
sub test21
Dim a(1 to 5,1 to 1) as long
debug.print ubound(a,2)
a = application.transpose(a)
debug.print ubound(a,2)
ReDim preserve a(1 to 1,1 to 10)
end sub
次元を入れ換えないと増やせないので、普段は最初から逆に配列をつくって
書き出すときに入れ換えてあげます
＞＞コストが条件分岐＞データ ＞配列同士だとそんな速度になったりするんですね これはすみません、適当です 少なくともIfは高速なので、体感は変わらないと思います でも比較するとき配列を一回余計に読み込むわけなので、 手間ですよね
省略の仕方はまた明日説明します （稲葉） 2017/07/24(月) 22:57
基本は分かったと思うので、次はてんこ盛りでいきます。
まず白紙のシートにmk_splを実行して、表を作ってください。
Sub mk_spl()
[a1:a100] = [=choose(mod(row(a1:a100),3)+1,"C","A","B")]
[b1:b100] = [=if(row(a1:a100),mod(row(a1:a100),4)+1)]
End Sub
下がサンプルコードです。
◆？が新しい教材です。
以下のコードを見て、一番最初の表を用いて、個人名ごとの合計をX・Y列に出力してみてください。
Sub test31()
'//C列に、A列の重複しないリストを作る
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Not dic.exists(Cells(i, "A").Value) Then
dic.Add Cells(i, "A").Value, "" '//Keyしか使わないので、Itemは空白
'dic.Item(Cells(i, "A").Value) = "" '//Addメソッドを使わず、Itemプロパティを使った例◆1
'dic(Cells(i, "A").Value) = "" '//Itemプロパティを省略した例◆2
End If
Next i
Dim ans As Variant
ans = dic.keys '//DictionaryのKeysメソッドで、Add（またはItem）で登録したKeyの配列を取得する◆3
Stop 'ローカルウィンドウで、ansの中身を確認
ans = Application.Transpose(ans)
Stop 'ローカルウィンドウで、ansの中身を確認◆4
Cells(1, "C").Resize(dic.Count).Value = ans
Set dic = Nothing
End Sub
Sub test32()
'//C・D列にA列の文字ごとの集計を出す
Dim i As Long
Dim rA As String
Dim rB As Long
'//Withステートメントを使うことで、変数のSetせずに使えます。◆5
With CreateObject("Scripting.Dictionary")
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
rA = Cells(i, "A").Value
rB = Cells(i, "B").Value
'//アイテムプロパティは、重複があっても、Addメソッドと違い、エラーにならずにkeyのItemを上書きしていく。◆6
.Item(rA) = rB + .Item(rA) '//登録したアイテムに、重複したアイテムを加算していく◆7
Next i
Cells(1, "C").Resize(.Count).Value = Application.Transpose(.keys)
Cells(1, "D").Resize(.Count).Value = Application.Transpose(.Items) 'Itemも同様に配列に出せる仕組みがあります。◆8
End With
End Sub
（稲葉） 2017/07/25(火) 13:26
ReDim Preserve Transpose解説ありがとうございます。
'//Withステートメントを使うことで、変数のSetせずに使えます。◆5
ああ、なるほど、そもそも
Set dic = CreateObject("Scripting.Dictionary")
dic.Add Key:=ID, Item:=dic.Count + 1
は
CreateObject("Scripting.Dictionary").Add Key:=ID, Item:=CreateObject("Scripting.Dictionary").Count + 1
と書いているのと同じであり、
With CreateObject("Scripting.Dictionary")
.Add Key:=ID, Item:=.Count + 1
End With
と書けるんですね。
＞個人名ごとの合計をX・Y列に出力 iとdic以外変数置換してないため読みづらいですが以下でどうでしょうか。 結果は正しく出てると思いますが、文法上おかしなところはないでしょうか。
Sub test105()
Dim i As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
'If Not dic.exists(Cells(i, "A").Value) Then
' dic.Item(Cells(i, "A").Value) = 0 '◆1を使用→""だと型が合わなくなるので0に変更→そもそも◆6でIf〜End If不要なのでコメントアウト
'End If
dic.Item(Cells(i, "A").Value) = dic.Item(Cells(i, "A").Value) + Cells(i, "C").Value '◆7
Next
Cells(1, "X").Value = Cells(1, "A").Value
Cells(2, "X").Resize(dic.Count).Value = Application.Transpose(dic.keys) '◆3,◆4
Cells(1, "Y").Value = Cells(1, "C").Value
Cells(2, "Y").Resize(dic.Count).Value = Application.Transpose(dic.Items) '◆8
End Sub
（tata） 2017/07/25(火) 20:17
＞CreateObject("Scripting.Dictionary").Add Key:=ID, Item:=CreateObject("Scripting.Dictionary").Count + 1
＞と書いているのと同じであり、
んー言葉にするの難しいですが、ちょっとちがいます
試しにそのままのコードでやってみるとわかると思いますが
＞Item:=CreateObject("Scripting.Dictionary").Count + 1
これだと、何周しても1のままです
Withの段階でインスタンスが作られるので、目に見えない変数が作られて ピリオドの前に存在しているといえばわかりますかね？
話変わりますが、下の判定ってどうなると思います？
Range("A1") = Range("A1")
Range("A1") Is Range("A1")
基本はほとんど説明してしまったので、あとはいくつか事例消化して 終わりにしましょうか。
集計に条件つけます A列で3以上の場合の合計と、それ以外の合計を出してみてください
ヒントはdictionaryのアイテムに入れられるのは、数値や文字以外も入れられます！
（稲葉） 2017/07/25(火) 23:18
＞何周しても1のまま ＞Withの段階でインスタンスが作られる 頓珍漢なこと言ってお恥ずかしい限りです。
＞下の判定
Range("A1") = Range("A1") 'True
Range("A1") Is Range("A1") 'False
になりました。…？
＞事例消化 ＞集計に条件 ＞dictionaryのアイテムに入れられるのは、数値や文字以外も入れられます
降参です、解説お願いたします。
Sub test106アイテムに数値以外入れる解()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim j As Long '出力配列 行
Dim 人名 As String
'辞書を準備。重複のない人名リスト(key)と、配列(0,0)(item)
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
人名 = Cells(i, "A").Value
If Not dic.exists(人名) Then dic.Add Key:=人名, Item:=Array(0, 0)
Next i
Stop 'Item に複数のアイテムを入れる？には、値ではなく「配列」そのものを入れる？→入れられない取り出せない？
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
人名 = Cells(i, "A").Value
If Cells(i, "C").Value < 3 Then '3未満だったら
dic.Item(人名)(0) = dic.Item(人名)(0) + Cells(i, "C").Value 'Itemの配列の1個目に加算
Else '3未満じゃなかったら(3以上)
dic.Item(人名)(1) = dic.Item(人名)(1) + Cells(i, "C").Value 'Itemの配列の2個目に加算
End If
Next
Stop
Range("E1").Resize(, 3).Value = Array("人名", "<3回/月の件数合計", "≧3回/月の件数合計")
Range("E1").Resize(dic.Count).Offset(1).Value = Application.Transpose(dic.keys)
Range("E1").Resize(dic.Count, 2).Offset(1, 1).Value = dic.Items
End Sub
'------
Sub test106別解()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim j As Long '出力配列 行
'辞書を準備。重複のない人名リスト(key)と、出力すべき行番号(item)
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Not dic.exists(Cells(i, "A").Value) Then dic.Add Key:=Cells(i, "A").Value, Item:=dic.Count + 1
Next i
'集計欄を準備
Range("E1").Resize(, 3).Value = Array("人名", "<3回/月の件数合計", "≧3回/月の件数合計")
Range("E1").Resize(dic.Count).Offset(1).Value = Application.Transpose(dic.keys)
'ここから処理
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
j = dic.Item(Cells(i, "A").Value) + 1 '書き込み先の行は辞書から取得+1
If Cells(i, "C").Value < 3 Then '3未満だったら
Cells(j, "F").Value = Cells(j, "F").Value + Cells(i, "C").Value 'F列に加算
Else '3未満じゃなかったら(3以上)
Cells(j, "G").Value = Cells(j, "G").Value + Cells(i, "C").Value 'G列に加算
End If
Next
End Sub
（tata） 2017/07/26(水) 22:14
今回、事例が良くありませんでした。 ごめんなさい。
3つコード例だしますが、参考程度に眺めてください。 今回の例では、2通りの集計ですので、計算式でも十分対応できますが、 これが都道府県別とかになると、効果を発揮します。 まあピボットテーブルのほうが早いですが！！
test33に書きましたが、コンボボックスの連動であったりとユーザーフォームなどに配列を保持したまま 使用する場面に向いていると思います。
Sub test33()
'//DictionaryにDictionaryを入れる例
' ユーザーフォームのような、動的に連動するリストなどに便利！
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim rA As String
Dim rC As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
rA = Cells(i, "A").Value
rC = Cells(i, "C").Value
If Not dic.exists(rA) Then
Set dic(rA) = CreateObject("Scripting.Dictionary") '//これを教えたかったけど、事例がよくなかったので、必要なかった・・・。
End If
dic(rA)(rC >= 3) = dic(rA)(rC >= 3) + rC
Next i
Dim ans As Variant
ReDim ans(1 To dic.Count, 1 To Range("E1:G1").Count)
Dim n As Long
Dim k As Variant
Dim kk As Variant
n = 0
For Each k In dic.keys '//こっちのやり方教えてなかった・・・◆
n = n + 1
ans(n, 1) = k
For Each kk In dic(k).keys
ans(n, IIf(kk, 2, 3)) = dic(k)(kk)
Next kk
Next k
Range("E1:G1").Value = [{"人名","<3回/月の件数合計","≧3回/月の件数合計"}]
Range("E2").Resize(UBound(ans, 1), UBound(ans, 2)).Value = ans
'検証用数式
Range("H2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,"">=3"")"
Range("I2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,""<3"")"
Set dic = Nothing
End Sub
Sub test34()
'//一番最初に月別に修正するコードのアレンジ！
' こっちのほうがシンプルで分かり易いですね。。。。
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim ans As Variant
ReDim ans(1 To Cells(Rows.Count, "A").End(xlUp).Row, 1 To Range("E1:G1").Count)
Dim i As Long
Dim rA As String
Dim rC As Long
Dim more As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
rA = Cells(i, "A").Value
rC = Cells(i, "C").Value
If Not dic.exists(rA) Then
dic(rA) = dic.Count + 1
ans(dic(rA), 1) = rA
End If
more = IIf(rC >= 3, 2, 3)
ans(dic(rA), more) = ans(dic(rA), more) + rC
Next i
Range("E1:G1").Value = [{"人名","<3回/月の件数合計","≧3回/月の件数合計"}]
Range("E2").Resize(UBound(ans, 1), UBound(ans, 2)).Value = ans
'検証用数式
Range("H2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,"">=3"")"
Range("I2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,""<3"")"
Set dic = Nothing
End Sub
Sub test35()
'//Dictionaryに配列を入れる場合のやり方
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim rA As String
Dim rC As Long
Dim more As Long
Dim w As Variant
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
rA = Cells(i, "A").Value
rC = Cells(i, "C").Value
If Not dic.exists(rA) Then
dic(rA) = Array(0, 0)
End If
more = IIf(rC >= 3, 0, 1)
'//ここが味噌。 配列ごと出して、書き換えてから入れなおす！
w = dic(rA)
w(more) = w(more) + rC
dic(rA) = w
'dic(rA)(more) = dic(rA)(more) + rC 'これだとだめー
Next i
Dim ans As Variant
ReDim ans(1 To dic.Count, 1 To Range("E1:G1").Count)
Dim n As Long
Dim k As Variant
Dim idx As Long
n = 0
For Each k In dic.keys
n = n + 1
ans(n, 1) = k
For idx = 0 To UBound(dic(k))
ans(n, idx + 2) = dic(k)(idx) '列番号が2列目、3列目なので、0+2、1+3で表現する
Next kk
Next k
Range("E1:G1").Value = [{"人名","<3回/月の件数合計","≧3回/月の件数合計"}]
Range("E2").Resize(UBound(ans, 1), UBound(ans, 2)).Value = ans
'検証用数式
Range("H2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,"">=3"")"
Range("I2").Resize(dic.Count).Formula = "=SUMIFS(C:C,A:A,E2,C:C,""<3"")"
Set dic = Nothing
End Sub
これで本当に終わりです。 配列の勉強ということで話をしましたが、エクセルの標準機能に勝てるコードはおそらくないので 標準機能で対応できないところに生かせればいいですね！
長々とお付き合いいただきありがとうございました。 （稲葉） 2017/07/27(木) 10:52
'//これを教えたかった ディクショナリの中にサブディクショナリが入るような形なのですね…
'//ここが味噌。 配列ごと出して、書き換えてから入れなおす！ なるほど。
使いこなせるようになるには道は遠そうですが、 勉強になりました。
物覚えの悪い生徒で申し訳なかったです。 ありがとうございました。 （tata） 2017/07/27(木) 22:03
>＞keyは氏名、 Itemには記入先の行番号 >＞を持たせるとよいのではないですか？ >＞（dicになければ、dic(s) = dic.count + 1 などと） >すみません、dic(s) = dic.count + 1 ちょっと理解ができていないので、 >もう少し基礎から調べながら考えてみます。 いいヒントもらってるのに勿体ないです。
それと、、、、
でぃくしょなりーを使うとMatch関数を使わなくていいっていうことかなぁ？
あと、本気で勉強するなら、
>Dim dic As Object
>Set dic = CreateObject("Scripting.Dictionary")
というのはやめて、
Dim myDic As Dictionary Set myDic = New Dictionary
としたほうがいいかも知れません。
以下のコピペじゃなくて、印刷して、見て、手入力すると、
もしかしたら僕の言いたいことの一端が解るかもしれません。
'※Microsoft Scripting Runtime を参照設定すること
Sub test001()
Dim vntAddData As Variant
Dim vntResult As Variant
Dim rngResult As Range
Dim myDic As Dictionary
Dim ix As Long
Dim ixH As Long
Dim ixV As Long
Dim sItem As String
With ActiveSheet
With .Range("A1").CurrentRegion
vntAddData = Intersect(.Cells, .Offset(1)).Value
End With
With .Range("F1").CurrentRegion
vntResult = Intersect(.Cells, .Offset(1)).Resize(UBound(vntAddData, 1)).Value
End With
End With
Set myDic = New Dictionary
For ix = LBound(vntResult, 1) To UBound(vntResult, 1)
sItem = vntResult(ix, 1)
If Len(sItem) = 0 Then Exit For
myDic.Add Key:=vntResult(ix, 1), Item:=ix
Next
With ActiveSheet.Range("F1").CurrentRegion
Set rngResult = Intersect(.Cells, .Offset(1, 1)).Resize(UBound(vntAddData, 1))
End With
vntResult = rngResult.Value
For ix = LBound(vntAddData, 1) To UBound(vntAddData, 1)
sItem = vntAddData(ix, 1)
If myDic.Exists(sItem) = False Then
myDic.Add Key:=sItem, Item:=myDic.Count + 1
End If
ixV = myDic(sItem)
ixH = Val(StrConv(vntAddData(ix, 2), vbNarrow))
vntResult(ixV, ixH) = vntAddData(ix, 3)
Next
With rngResult.Resize(myDic.Count)
.Columns(0).Value = WorksheetFunction.Transpose(myDic.Keys)
.Value = vntResult
End With
End Sub
（まっつわん） 2017/07/28(金) 15:55
まっつわんさん 文句がある！！ めっちゃDictionary書けるじゃないですか！ 私にも教えてください。（参照設定については、第一に候補が出るかどうかですよね？） （スレッドを変えたほうがいいのであれば、別に立てます。）
Dictionaryの使い方を自分でおさらいしている中で教えてほしいところがありまして、
[[20170728094322]] 『「3つ以上のコンボボックス連携について」(Voume1』（関数がにがて）
の中で参照している
[[20081217082039]] 『3つ以上のコンボボックス連携について』(Voume11）
で配列の中にDictionaryを入れていますが、Dictionaryの中にDictionaryを入れる手段と比較して メリット・デメリットが分かりません。 勝ち負けではなく、使い方として使い分けができれば、いいなと思っています。
例としては以下のコードでも結果は同じだと思うのです。 リンク先の野菜の表をサンプルとして想定しています。
Private dic As Dictionary '[参照設定]MicrosoftScriptingRuntime
Private Sub UserForm_Initialize()
Dim v As Variant
v = Range("A1").CurrentRegion.Value
Set dic = New Dictionary
Dim i As Long
For i = 2 To UBound(v, 1)
Call ReDic(dic, v, i, 1)
Next i
ComboBox1.List = dic.keys
End Sub
Private Sub ReDic(ByRef IDic As Dictionary, ByVal v As Variant, ByVal i1 As Long, ByVal i2 As Long)
Dim k As String
k = v(i1, i2)
If Not IDic.exists(k) Then
Set IDic(k) = New Dictionary
End If
If UBound(v, 2) - i2 > 1 Then
Call ReDic(IDic(k), v, i1, i2 + 1)
Else
IDic(k) = (v(i1, i2 + 1))
End If
End Sub
（稲葉） 2017/07/28(金) 16:44
＞As Dictionary ググり直してみたら ＞配布するEXCELシートでも参照設定はちゃんと残ったまんまなので(excelバージョンが上位又は同じなら)、 ＞参照設定のまま保存しちゃえ。という選択もあり という記述を発見。
ということは、他人のパソコンで、「設定作業」をしてもらわなくても、 特に問題なく動く、ということなんですよね？ 設定したパソコンでしか動かないものと勘違いをしていました。
＞Dim myDic As Dictionary ＞Set myDic = New Dictionary ググった時に出てきていた記述では、 Dim myDic As New Dictionary と書かれている事例が多かったのですが、 実は変数宣言時にNewするのは避けるべきだったんですね。 まっつわんさんの御提示見て調べなおして初めて気づきました。 http://thom.hateblo.jp/entry/2016/09/27/221527
閑話休題
＞いいヒントもらってるのに勿体ないです 汗顔の至りです
＞手入力すると、もしかしたら僕の言いたいことの一端が解るかも ええと、 myDic.a まで記述したタイミングで、候補一覧が出たり、 myDic.Add の状態で、Add(key,Item)といったポップアップガイダンスが出るようになりました!
＞Val(StrConv(vntAddData(ix, 2), vbNarrow)) 全角３月 から 3 を取り出すの、こんな方法があるんですね。 文字列内の全角文字 (2 バイト) を半角文字 (1 バイト) に変換し、 指定した文字列に含まれる数値を適切なデータ型に変換して返す。
で、Matchを使わなくて良くなる、と。
既に集計済みの人名、月が記入されている場合に対応した、 集計欄から辞書登録→追加分辞書登録の流れ、模範解答ありがとうございます。
いやはや、いろんな方から親切にして頂いて恐縮です。 長い間、「問題解決」と言うよりは「勉強」に付き合って頂いてありがとうございました。 （tata） 2017/07/28(金) 19:38
すっかり、書き込みしたことを忘れてました。
> まっつわんさん > 文句がある！！ > めっちゃDictionary書けるじゃないですか！
だから、「少し勉強してみた」と書いたつもりです。
いいヒントがあったから、いいアプローチができた、
結果、それっぽいものが書けた、というだけの話です。
問題は、どのような道具を使うかの以前に、
どのようなロジックを思いつくかかと。。。
(そこは万年初心者でもエキスパートに対抗できる部分なので^^
自分だけの経験と知識をフル活用しましょう＾＾)
>Dictionaryの使い方を自分でおさらいしている中で教えてほしいところがありまして、 う〜ん。この辺は興味ないし、さっと思いつかないので、、、、 やるとしても、稲葉さんより後ろからのスタートになりそうです。 興味があれば、別スレッドで、エキスパートさんからのアドバイスを乞うてください。
tataさんへ＞
> ええと、 > myDic.a まで記述したタイミングで、候補一覧が出たり、 > myDic.Add の状態で、Add(key,Item)といったポップアップガイダンスが出るようになりました! 候補一覧は 「Ctrl + スペースキー」ショートカットで出ます。 これが出るだけで、コーディング中のストレスがすごく緩和されると思います。 でないと、全部一字一句暗記してないと次使えない＞＜
Set dic = CreateObject("Scripting.Dictionary")
が掲示板で一般的に使用されるのは、
参照設定の話が通じなくて「動かない!」となるのを、
無意識かどうかわかりませんが、経験的に敬遠されているのだろうなと
推測します。
＞で、Matchを使わなくて良くなる、と。
でぃしょなりーを使うのもそういう事でしょう。
この場面でVal関数を使うのは、あまりいい事ではないですが、特定の場面では使えるよと。
色々な技を持っておくと何かの時に使えるかも知れませんよね？
>「勉強」に付き合って頂いてありがとうございました。 面白いテーマを提供してくださってありがとうございます。 こちらも、勉強させていただきました＾＾ その結果をああだこうだといいながら共有するのはとても意義のあることだと思います＾＾ （まっつわん） 2017/08/07(月) 12:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.