Excel VBAでの連想配列の作成方法と要素の存在確認について
- Excel VBAを使用してデータを連想配列として格納したいと考えています。MsgBoxでキーとアイテムを表示させることはできますが、Existsを使用して要素の存在を確認するとFalseが返ってきます。配列にデータが格納されていないのか、格納方法や存在確認方法について教えてください。
- Excel VBAでデータを連想配列として格納する方法について教えてください。MsgBoxを使用してキーとアイテムを表示させることはできますが、Existsを使用して要素の存在を確認するとFalseが返ってきます。連想配列にデータを格納する方法や要素の存在確認方法を教えてください。
- Excel VBAを使用してデータを連想配列として格納したいと考えています。MsgBoxでデータを表示させることはできますが、Existsを使用して要素の存在を確認するとFalseが返ってきます。連想配列にデータを格納する方法や要素の存在確認方法について教えてください。
- ベストアンサー
以下のデータがあり、これを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
- mango100
- お礼率80% (4/5)
- 会計ソフト
- 回答数1
- ありがとう数9
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
変更前： myDic.Add Cells(i, 1), Cells(i, 2) 変更後： myDic.Add Cells(i, 1).value, Cells(i, 2) ＃実行中にローカルウィンドウでmyDicの中身を確認しながら(つまりデバッグしながら＝ステップ実行しながら)進めてみると，セル自体をキー値として格納している様子を確認できます。 変更後と見比べてみると判りやすいかと。
関連する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 のわずか一行で済むということですよね？
- ベストアンサー
- オフィス系ソフト
- VBA 連想配列と回数
Widowsは7 Excelは2013を使用しています。 E列のデータの重複しないリストをK列に書きだすところまでは出来たのですが、 同じ商品名が何回出てきたをカウントしたいのですが、 下記の連想配列で一緒に出来るのか、分けて組まないといけないのか、 教えて下さい。 よろしくお願い致します。 '---------------------------- '重複しないリストをK列に書き出す '---------------------------- Dim Dic, i As Long, buf As String, Keys Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To maxRow buf = Cells(i, 5).Value 'E列のセルの値をbufに格納する If Not Dic.Exists(buf) Then '辞書にまだ登録されていなければ Dic.Add buf, buf 'そのセルの値を連想配列に登録する。 End If Next i '出力 Keys = Dic.Keys For i = 0 To Dic.Count - 1 Cells(i + 2, 11) = Keys(i) 'K2から下にリスト作成 Next i Set Dic = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- VBA 複数シートに渡る連想配列
Winは7、Excelは2013を使用しています。 画像の様に、シート2のＡ列の科目を連想配列のキーし、 シート2以降のシートのＢ列とＣ列のデータを同時に格納していきたいと思っています。 6月には、4～5月の2ヶ月分、7月には4～6月分の3ヶ月分、となるので、 シートの数だけ繰り返したいです。 それで、下記を自分で考えてみたのですが、 数々エラーになり、上手く行きません。 どなたか、ご教示頂けます様お願い致します。 Sub test_年間() '--------------------------------------- '科目を連想配列に登録し、年間集計シートに書き出す '--------------------------------------- Dim n As Integer Dim maxRow As Integer Dim Dic(36) Dim buf As String Dim Keys Dim k As Integer Dim a As Integer For s = 2 To Worksheets.Count Sheets(s).Activate maxRow = Range("A65536").End(xlUp).Row '------------------------------------ '格納 '------------------------------------ Set Dic(s) = CreateObject("Scripting.Dictionary") For n = 2 To maxRow buf = Cells(n, 1).Value 'A列のセルの値をbufに格納する b = Cells(n, 2).Value 'B列のセルの値をbに格納する c = Cells(n, 3).Value 'C列のセルの値をcに格納 If buf = "" Then '空白セルではなく ElseIf Not Dic(s).Exists(buf) Then '辞書にまだ登録されていなければ Dic(s).Add buf, b 'そのセルの値を連想配列に登録する。 'ここで Dic(S+1).Add buf, c のような事がしたいのですが.... 'でもS+1はエラーになります。 End If Next n Next s '--------------------------------------------- '書き出す '--------------------------------------------- For s = 2 To Worksheets.Count Keys = Dic(s).Keys Worksheets("年間集計").Activate With Worksheets("年間集計") k = 1 a = 1 r = 0 For n = 0 To Dic(s).Count - 1 k = k + 1 '最初の書き出しは2行目から Cells(k, 1 + r) = Keys(n) Cells(k, 2 + r) = Dic(s)(Keys(n)) ' Cells(k, 3 + r).NumberFormatLocal = "[h]:mm" ' Cells(k, 3 + r) = Dic(s + 1)(Keys(n)) r = r + 3 Next n End With Next s Set Dic(s) = Nothing MsgBox "終了" End Sub 勝手申しますが、お礼は来週月曜日なります。 どうかお許し願います。
- ベストアンサー
- Excel（エクセル）
- 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製品
- VBA 複数のシートをまたいでの連想配列
win7、Excelは2013を使用しています。 添付画像の様に、12シートの合計を連想配列に格納しsheet13に書き出したいのですが、プロシージャーの下から6行目のところで、エラーコード451が出ます。 どの様に変更すれば良いか教えて下さい。 Sub 年間集計() Dim Dic Dim i As Integer Dim j As Integer Dim sh As Worksheet Dim rng As Range Dim buf As String Dim num As Integer Set Dic = CreateObject("Scripting.Dictionary") For Each sh In Worksheets For Each rng In sh.Range("J2", sh.Cells(Rows.Count, 10).End(xlUp)) buf = rng.Value num = rng.Offset(, 1).Value If Not Dic.Exists(buf) Then Dic.Add buf, num Else Dic.Item(buf) = Dic.Item(buf) + num End If Next rng Next sh j = 2 With Worksheets("Sheet13") For i = 0 To Dic.Count - 1 .Cells(j, 1) = Dic.Keys(i) ’エラー箇所 .Cells(j, 2) = Dic.Items(i) j = j + 1 Next i End With End Sub
- ベストアンサー
- Excel（エクセル）
- VBA スケジュール表作成_連想配列で祝日設定
Win10でExcelは2016を使用しています。 「西暦」をMsgBoxで指定し、スケジュール表を作成するマクロを作成中です。 日曜と祝日のセルをグレー&赤文字にさせたいので、別シートに祝日を表にしそれを連想配列に記憶させて、祝日も赤文字にさせたいのですが、下記のマクロですと祝日の曜日のセルをグレー&赤文字に出来ず行き詰っています。 ------ Sub スケジュール_日_祝_休ver() Dim ws1 As Worksheet Dim myDic As Object Dim buf As String Dim i As Integer Dim Keys() As Variant Dim ws2 As Worksheet 'シート Dim ye As Integer '年 Dim mo As Integer '月 Dim dy As Integer '日 Dim dLast As Integer '最終日 Dim r As Integer '日付書き込み列 Set myDic = CreateObject("Scripting.Dictionary") Set ws1 = Worksheets("祝日") maxRow = ws1.Range("C65536").End(xlUp).Row For i = 2 To maxRow buf = ws1.Cells(i, 3).Value 'C列のセルの値をbufに格納する If buf = "" Then '空白セルではなく ElseIf Not myDic.Exists(buf) Then '辞書にまだ登録されていなければ myDic.Add buf, 1 'そのセルの値を連想配列に登録する。 End If Next i ye = Application.InputBox("西暦を入れて下さい", Type:=1) Set ws2 = Worksheets("白紙") With ws2 r = 2 '当年1～12月 '1日の列に月を表示 For mo = 1 To 12 If mo = 1 Then .Cells(1, r) = "’" & ye & "年" & mo & "月" .Cells(1, r).Font.Bold = True .Cells(1, r).Font.Name = "HGP創英角ゴシックUB" .Cells(1, r).Font.Size = 20 Else .Cells(1, r) = mo & "月" .Cells(1, r).Font.Bold = True .Cells(1, r).Font.Name = "HGP創英角ゴシックUB" .Cells(1, r).Font.Size = 20 End If '最終日取得 dLast = Day(DateSerial(ye, mo + 1, 0)) '日にちと曜日を入れ、日・祝 のセルをグレー&赤文字 For dy = 1 To dLast .Cells(3, r) = ye & "/" & mo & "/" & dy .Cells(3, r).NumberFormatLocal = "d" .Cells(4, r) = WeekdayName(Weekday(.Cells(3, r).Value), True) Key = .Cells(3, r).Value If .Cells(4, r).Value = "日" Or .Cells(3, r).Value = myDic.Item(Key) Then '日と祝日 .Cells(4, r).Font.ColorIndex = 3 ws2.Range(Cells(5, r), Cells(73, r)).Select With Selection.Interior .ColorIndex = 15 End With End If r = r + 1 Next dy '月変わりに縦太線を引く .Range(Cells(1, r - 1), Cells(73, r - 1)).Select With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Next mo End With End Sub ------- 原因をさぐるべくＦ8で確認しながら進めたところ、 「If .Cells(4, r).Value = "日" Or .Cells(3, r).Value = myDic.Item(Key) Then 」 のところで、.Cells(3, r).Value は「2020/1/1/」でmyDic.Item(Key)は「2020/01/01/」になっていました。 やはり、これですと同じとは認識されないのでしょうか？ でも、月日が2ケタの祝日のセルをグレー&赤文字にならず、他の原因のような気もします... -- どなたかご教示頂けましたら有難いです。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセル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 頭のなかがこんがらがってしまいます お願いです 出来れば説明付きで教えていただけませんか よろしくお願いします
- 締切済み
- オフィス系ソフト
- [VBA] 連想配列について
こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windowsXP SP3 Office=Excel2003(11.8347.8403) SP3 データ量が多いのでVLOOKUPの処理を連想配列を使ってやりたいのですが、できなくて困っています。 言葉では説明しずらいので、やりたいことのコードを提示します。 :Sheet2 品名 1月 2月 りんご 2 3 ばなな 4 5 下記、VBAコード ---------------------------------------------------- Option Explicit Sub test() Dim oDict As Object Dim Ary As Variant Dim EndRow As Long Dim i As Long Ary = Sheets("Sheet2").Range("A2:C3").Value Set oDict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Ary) oDict(Ary(i, 1)) = Ary(i, 2) oDict(Ary(i, 2)) = Ary(i, 3) Next i With ThisWorkbook.Sheets("Sheet1") EndRow = .Cells(Rows.Count, 1).End(xlUp).Row Ary = .Range("A1:Y" & EndRow).Value For i = 2 To EndRow Ary(i, 24) = oDict(Ary(i, 1)) Ary(i, 25) = oDict(Ary(i, 2)) Next i .Range("A1:Y" & EndRow) = Ary End With MsgBox "done" End Sub ---------------------------------------------------- というコードなのですが、 For i = 1 To UBound(Ary) oDict(Ary(i, 1)) = Ary(i, 2) oDict(Ary(i, 2)) = Ary(i, 3) Next i が、oDict(Ary(i, 1)) = Ary(i, 2)だけ配列に格納される状態です。 指定の文字列(Key)に対応するItemを返すのが連想配列だと思うのですが、上記コードで、 oDict(Ary(1, 1))=2 oDict(Ary(2, 1))=4 oDict(Ary(1, 2))=3 oDict(Ary(2, 2))=5 という配列に格納されない理由がわかりません。 Scripting.Dictionaryで辞書に格納できるデータになにかしらの制限があるのでしょうか？ 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- 配列変数に格納したデータを計算する方法はありますか？
簡単な例ですが、例えばB列にあるデータの平均値を求めるときに以下のようにしています。 sub 平均計算() Dim X(1 To 1000, 1 To 1) As Variant, i as Integer For i = 10 To 1000 X(i, 1) = WorksheetFunction.Average _ (Range(Cells(i - 9, 2), Cells(i, 2))) Next Range(Cells(1, 1), Cells(1000, 1)) = X End Sub ここで処理速度改善のため、B列のデータを別の配列変数Yに格納してから平均値を求めるというようなことをしたいのですが、そんなことは可能でしょうか？イメージとしてはこんな感じです。 Y = Range(Cells(1, 2), Cells(1000, 2)) for i = 1 to 1000 X(i, 1) = WorksheetFunction.Average _ (Range(Y(i - 9, 2), Y(i, 2))) Next 当然これはエラーになってしまいますが、このようなことを可能にする方法があれば、どなたか教えてください！よろしくお願いします。
- 締切済み
- Visual Basic
- 配列に格納したデータを指定行以下に転記する方法
excel2000を使っています。 以下のコードだと最終行にデータが転記されます。これを４行目に確定して、転記したいのです。常に４行目つまりＡ列４行目以下に上書きしたいのです。 その場合コードをどのように変更すべきでしょうか？ Sub 配列() With ActiveSheet ' 配列に格納 --------------------------- Dim i As Integer Dim LastRow As Long Dim SaleAry As Variant ' 配列に格納 --------------------------- SaleAry = Array(.Range("t4"), .Range("e5"), .Range("ｇ5"), .Range("o5")) End With ' 転記 --------------------------- With Worksheets("daityou") LastRow = .Range("A65536").End(xlUp).Row For i = 0 To UBound(SaleAry) .Cells(LastRow + 1, i + 1).Value = SaleAry(i) ' Next i End With Set SaleAry = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。 少し前からいろんなサイトをみて勉強していたのですが、 ローカルウィンドウというもを知らずにやってました。 今後のエラーへの対応にすごく役に立ちそうです。 ありがとうございました。