VBAでDictionaryを使いまわす方法とは？
- VBAでDictionaryオブジェクトを使いまわすことは可能でしょうか？
- Subデータ()の関数化による辞書への都度の登録作業を避ける方法を知りたいです。
- AさんとBさんの買い物合計を計算する際に、Dictionaryの値を使いまわしたいです。
- ベストアンサー
ＶＢＡにて Dictionaryを使いまわしたい
Dictionaryオブジェクトをデータベースとして、 色々なマクロから使うことは出来るのでしょうか？ 以下のようなイメージですが、もちろん、これは動きません。 Sub データ()を関数にすると、その都度、辞書に登録という作業が生じるため、損をした気になるので質問しました。 Sub データ() 省略 Set myDic = CreateObject("Scripting.Dictionary") 省略 myDic.Add "菊", "50円" myDic.Add "バラ", "100円" myDic.Add "ひまわり", "100円" 省略 End Sub Sub Aさんの買い物合計() 合計=myDic.Item("菊")+myDic.Item("ひまわり") End Sub Sub Bさんの買い物合計() 合計=myDic.Item("バラ")+myDic.Item("ひまわり") End Sub
- VitaminBB
- お礼率95% (2783/2916)
- Excel（エクセル）
- 回答数2
- ありがとう数3
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その１） マクロを書くときは、変数の宣言を必ず行う癖をつけましょう。 そうすることで、「この変数を他のマクロで使うにはどうしたらいいのか」という具合に発想が広がります。 その２） 「50円」だの「100円」だのでは、足し算は（原則）できません。 数字は数値でデータを持たせるように、習慣づけましょう。 標準モジュール： dim myDic as Object Sub データ() Set myDic = CreateObject("Scripting.Dictionary") myDic.Add "菊", 50 myDic.Add "バラ", 100 myDic.Add "ひまわり", 100 End Sub Sub Aさんの買い物合計() dim 合計 as double 合計=myDic.Item("菊")+myDic.Item("ひまわり") msgbox 合計 & "円" End Sub Sub Bさんの買い物合計() dim 合計 as double 合計=myDic.Item("バラ")+myDic.Item("ひまわり") msgbox 合計 & "円" End Sub 手順： １．データを実行する ２．買い物合計を実行する。
その他の回答 (1)
- kybo
- ベストアンサー率53% (349/647)
myDicをPublicかPrivateで宣言すればいいだけの話ではないでしょうか？ そのモジュールの先頭に以下のように記述してみてください。 Public myDic As Object
お礼
回答ありがとうございます。
関連するQ&A
- エクセルVBAでDictionaryオブジェクトについて
エクセル2000です。 教えてください。 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html というサイトで 「myDic.Add Cells(i, 1).Value, Cells(i, 2).Value は myDic(Cells(i, 1).Value) = Cells(i, 2).Value と書くこともできます。 」 という記述を見つけました。 試してみたところ Sub test01() Dim myDic As Object Dim myAr() Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To 7 If Not myDic.exists(Cells(i, 1).Value) Then myDic.Add Cells(i, 1).Value, Cells(i, 2).Value End If Next i myAr() = myDic.Keys MsgBox Join(myAr()) End Sub Sub test02() Dim myDic As Object Dim myAr() Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To 7 myDic(Cells(i, 1).Value) = Cells(i, 2).Value Next i myAr() = myDic.Keys MsgBox Join(myAr()) End Sub 上記２つのマクロは、Keyに関してはまったく同じ働きをするようです。 ところがItemに関しては、Keyが重複した場合、あとから出てきた方に上書きされるようです。 これはtest01では、Keyの重複を排除しているためItemは最初に出たものが残る、test02は重複の場合、無条件でKeyが上書きされ（ても値は変化しないけど）、したがってItemも上書きされるという理解でよろしいのでしょうか？ ならば、Itemを気にしない場合、わざわざ If Not myDic.exists(Cells(i, 1).Value) Then myDic.Add Cells(i, 1).Value, Cells(i, 2).Value End If と、3行も費やして重複のチェックをしなくとも myDic(Cells(i, 1).Value) = Cells(i, 2).Value のわずか一行で済むということですよね？
- ベストアンサー
- オフィス系ソフト
- 二次元のDictionary
ASPは全くの初心者です。 今回、二次元のDictionaryを使って値を表示させたいのですが 行き詰ってしまいました。 以下のコードをどのように変換すれば良いですか？ <%@ LANGUAGE = VBSCRIPT %> <% call dictionary_create() Sub dictionary_create() Dim objParent Dim objChild dim x Set objParent = CreateObject("Scripting.Dictionary") For x=0 to 9 Set objChild = CreateObject("Scripting.Dictionary") objChild.Add "kaigi", "会議名"&i objChild.Add "Id", "0"&i objParent.Add x, objChild Set objChild = Nothing Response.Write objParent.Item("ConfName") Next end sub %>
- 締切済み
- Microsoft ASP
- 以下のデータがあり、これをExcel VBAの連想配列として格納したい
以下のデータがあり、これをExcel VBAの連想配列として格納したいと考えています。 MsgBoxでキーとアイテムを表示させると表示されるのですが、 最後に一例としてExistsで確認するとFalseが返ってきます。 これは配列に格納されていないのでしょうか。 また格納されていないとすると、どうすれば格納できるのでしょうか。 A 列 B列 35 apple 37 orange 40 banana 以下がコードです。 sub test() Dim i as integer Dim myDic as Object Dim keys as Variant Set myDic = CreateObject("Scripting.Dictionary") For i = 1 to 3 myDic.Add Cells(i, 1), Cells(i, 2) Next i keys = myDic.keys For Each keys In myDic MsgBox "キー名：" & keys & vbCr & "値：" & myDic.Item(keys) Next keys MsgBox myDic.Exists(35) End Sub
- ベストアンサー
- 会計ソフト
- 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ペコッ
- ベストアンサー
- オフィス系ソフト
- VBAのdictionaryでAddの使い方
ＶＢＡでつぎのコードを実行すると、a,A1.1の後、a,A2.2と表示します。 dicには、a,A2.2の設定をしていないのになぜこうなるのでしょうか？ どなたか教えてください。 Sub sample() Dim dic As Object Dim subDic As Object Set dic = CreateObject("Scripting.Dictionary") Set subDic = CreateObject("Scripting.Dictionary") subDic.Add "A1", 1 dic.Add "a", subDic subDic.Add "A2", 2 '結果表示 Dim key1 As Variant Dim key2 As Variant For Each key1 In dic.keys For Each key2 In dic(key1).keys MsgBox key1 & "," & key2 & ". " & dic(key1)(key2) Next Next End Sub
- ベストアンサー
- オフィス系ソフト
- Dictionaryのitemを効率よく配列に格納
まだエクセル2000です。 A列に商品名（約1,000種類） B列に分類名（10種類） C列に売上高 がある表があります。 （実際はその他の欄もありますが、質問のため単純化しています） 1行1レコードで時系列順に記載されていますので商品名も分類名も重複しています。 （もちろんデータ自体は重複していません。） 行数は不定です。 このデータから、各商品ごとに各分類別の売上高一覧（同一商品名でも分類が違えば別に集計）を作成するため、Dictionaryオブジェクトを利用して以下のマクロを書きました、 Sub test01() Dim myDic As Object Dim myV, myW, myX Dim i As Long, n As Long Dim ws As Worksheet With Sheets("Test01") myV = .Range("A1", .Cells(Rows.Count, "C").End(xlUp)).Value '対象範囲を配列に End With ReDim myW(1 To UBound(myV), 1 To 3) '一覧データ格納用2次元配列サイズ設定 Set myDic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(myV) If Not myDic.Exists(myV(i, 1) & myV(i, 2)) Then '商品+分類が初出なら myDic.Add myV(i, 1) & myV(i, 2), myV(i, 3) 'keyに追加、itemに売上 n = n + 1 'カウント myW(n, 1) = myV(i, 1) '配列に商品名 myW(n, 2) = myV(i, 2) '配列に分類名 Else '商品+分類が既出なら myDic(myV(i, 1) & myV(i, 2)) = myDic(myV(i, 1) & myV(i, 2)) + myV(i, 3) 'itemに売上加算 End If Next i ReDim myX(0 To UBound(myDic.Items)) 'item配列格納用1次元配列サイズ設定 myX = myDic.Items '1次元配列にItem格納 For i = 1 To UBound(myDic.Items) + 1 myW(i, 3) = myX(i - 1) '配列から配列へitemデータ複写 Next i Set ws = Sheets.Add 'シート追加 ws.Range("A1").Resize(UBound(myDic.keys) + 1, 3).Value = myW '配列張り付け Set myDic = Nothing Set ws = Nothing End Sub これで正常かつ高速に作動するのですが、疑問点があります。 itemのデータを2次元配列、myWの3列目に格納するのに、いったん1次元配列myXを経由しなくともよい方法はないのかということです。 ここを変えてみても多分実行速度にほとんど影響はないとは思いますが、何か無駄なことをしているようで気になります。 itemを配列myWにとりこまず、直接ワークシートのC1以下にApplication.Transpose(myDic.items)で張るのが効率的と思いますが、わたしのエクセルがまだ2000のため、Transpose関数の限界、5461個にひっかかるおそれがあり、使えません。 どうかご教示ください。
- ベストアンサー
- その他MS Office製品
- DictionaryとRedim
Windows XP ＆ Visual studio2005を使用しています。 以下のようなコードを書きました。 Sub Main() Dim dic1 As New Dictionary(Of Integer, Integer()) Dim dic2 As New Dictionary(Of Integer, Integer()) Dim arr1(3) As Integer Dim arr2(3) As Integer arr1(0) = 0 arr1(1) = 1 arr1(2) = 2 arr1(3) = 3 dic1.Add(0, arr1) arr1(0) = 100 arr1(1) = 101 arr1(2) = 102 arr1(3) = 103 dic1.Add(100, arr1) arr2(0) = 0 arr2(1) = 1 arr2(2) = 2 arr2(3) = 3 dic2.Add(0, arr2) ReDim arr2(3) arr2(0) = 100 arr2(1) = 101 arr2(2) = 102 arr2(3) = 103 dic2.Add(100, arr2) '*ここで止めてdic1とdic2の内容をみる dic1 = Nothing dic2 = Nothing End Sub コメントの位置で止めて、dic1とdic2の内容を見ると dic1の方は、keyの値にかかわらず、100～103が入っていますが dic2の方は、それぞれ0～3と100～103が入っています。 どうしてこのような違いが出てくるのでしょうか？
- 締切済み
- Visual Basic
- DictionaryオブジェクトのItemの型は？
このコードの○○○には何を書けばよいのでしょうか？ （下から2行目です） コードの間は適当に省略しています。 Sub test() Set Dic = CreateObject("Scripting.Dictionary") Items = Dic.Items j = Func2(Items(k)) End Sub Function Func2(a As ○○○) End Function
- ベストアンサー
- Excel（エクセル）
- エクセルVBAで重複入力の排除
すでに入力規則はリストで使用しております。 そのためVBAで重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myDic As Object Dim c As Variant, varData As Variant Dim i As Long If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub Set myDic = CreateObject("Scripting.Dictionary") varData = Range("A1:A50").Value For Each c In varData If Not c = Empty Then i = i + 1 If Not myDic.Exists(c) Then myDic.Add c, Null End If End If Next If myDic.Count < i Then MsgBox Target & " は重複！" Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBA
エクセル2003です 勉強中です 教えてください Sheet1 A B C D 1 日付 種類 数量1 数量2 2 2月3日 C 300 10 3 2月4日 B 200 5 4 2月5日 A 100 20 5 2月3日 A 100 10 6 2月4日 B 200 5 7 2月5日 C 300 20 8 2月3日 A 300 20 9 2月4日 C 200 5 10 2月5日 B 100 10 Sheet1 F G H I 1 日付 種類 数量1 数量2 2 2月3日 A 400 3 2月3日 C 300 4 2月4日 B 600 5 2月5日 A 100 6 2月5日 C 400 7 したい事 *A列～D列のデータをF列からI列へ複数条件の集計をしたいのですが *A列～D列の数値が変動すると勝手に自動で集計をして欲しい（シートがアクティブでなくても） *下記コードでC列までの集計ができますがD列の集計がわかりません （増やそうとすると頭の中がぐちゃぐちゃになって・・・） *前回の集計が残ってしまう Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myDic As Object, myKey, myItem Dim myVal, myVal2, myVal3 Dim i As Long Range("F2", Range("I" & Rows.Count).End(xlUp)).ClearContents Range("F1:I1").Value = Range("A1:D1").Value Set myDic = CreateObject("Scripting.Dictionary") ' データを配列に格納 myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value ' myDicへデータを格納 For i = 1 To UBound(myVal, 1) myVal2 = myVal(i, 1) & "_" & myVal(i, 2) If Not myVal2 = "_" Then If Not myDic.exists(myVal2) Then myDic.Add myVal2, myVal(i, 3) Else myDic(myVal2) = myDic(myVal2) + myVal(i, 3) End If End If Next 'Key,Itemの書き出し myKey = myDic.keys myItem = myDic.items For i = 0 To UBound(myKey) myVal3 = Split(myKey(i), "_") Cells(i + 2, 6).Value = myVal3(0) Cells(i + 2, 7).Value = myVal3(1) Cells(i + 2, 8).Value = myItem(i) Next Set myDic = Nothing '並べ替え Range("F2", Range("H" & Rows.Count).End(xlUp)).Sort _ Key1:=Range("F2"), Order1:=xlAscending, _ Key2:=Range("G2"), Order2:=xlAscending, _ Header:=xlGuess End Sub 頭のなかがこんがらがってしまいます お願いです 出来れば説明付きで教えていただけませんか よろしくお願いします
- 締切済み
- オフィス系ソフト
お礼
回答ありがとうございます。