• ベストアンサー

エクセル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 上記2つのマクロは、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 のわずか一行で済むということですよね?

質問者が選んだベストアンサー

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

#2です。 例えば、 >If Not myDic.exists(Cells(i, 1).Value) Then >myDic.Add Cells(i, 1).Value, Cells(i, 2).Value >End If の使い方としては、 If Not myDic.Exists(Cells(i, 1).Value) Then myDic(Cells(i, 1).Value) = Cells(i, 2).Value Else myDic(Cells(i, 1).Value) = myDic(Cells(i, 1).Value) + Cells(i, 2).Value End If のように ・キーがなければキーに値をセットする。 ・キーがあればそのアイテムに新しい値を加算していく。 と言った場合に、存在しないキーによるエラー回避の意味もあるでしょうか。

merlionXX
質問者

お礼

なんとItenの加算が出来るんですね! 文字列の場合は結合されるんですね!驚きました。 Sub test04() Dim myDic As Object Dim myAr(), myAr2() Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To 7 If Not myDic.Exists(Cells(i, 1).Value) Then myDic(Cells(i, 1).Value) = Cells(i, 2).Value Else myDic(Cells(i, 1).Value) = myDic(Cells(i, 1).Value) + Cells(i, 2).Value 'Itemデータを加算 End If Next i myAr() = myDic.Keys myAr2() = myDic.Items MsgBox Join(myAr()) & vbLf & Join(myAr2()) End Sub

その他の回答 (3)

  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.4

>test02は重複の場合、無条件でKeyが上書きされ(ても値は変化しないけど) >したがってItemも上書きされるという理解でよろしいのでしょうか? ちょこっと、否、だいぶ違うみたい。。。(^^;;; >myDic(Cells(i, 1).Value) = Cells(i, 2).Value これは、一体、何をしているのでしょう。 それは、 myDic.Item(Cells(i, 1).Value) = Cells(i, 2).Value のように、Itemプロパティが省略された形で キーのセットではなくて 既にキーに関連付けされた項目の変更をしていることになります。 キーが無いときはどうするのじゃ、と疑問が生じるでしょうが、 その場合には以下のようにちゃんとキーを作ってくれるのです。 「項目を変更するときに引数 key の値が見つからない場合は 引数 newitem で指定された項目(今回は右辺のCells(i, 2).Value) と関連付けられた新しいキーが作成されます」 ここら辺りはヘルプに詳しく書いてあります。 お暇なときには、ヘルプで遊びませう。。(^^;;;   以上です。  

merlionXX
質問者

お礼

こんばんは、onlyromさま。 いつもありがとうございます。 日本まけちゃいましたね、残念です。 myDic(Cells(i, 1).Value) = Cells(i, 2).Valueは キーがないときには新しいキーが作成され、あるときは既にキーに関連付けされたItemを変更するということですね。 よく分かりました。 ありがとうございます。

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

>Itemを気にしない場合、 >myDic(Cells(i, 1).Value) = Cells(i, 2).Value >のわずか一行で済むということですよね? キーに対して最終アイテムを必要としている場合ならOKでしょうね。 逆に最初のアイテムを必要とするのなら、 >test01では、Keyの重複を排除しているためItemは最初に出たものが残る こちらでしょうね。 それぞれは何を必要とするかで使い分けると思いますよ。 あくまで一例に過ぎないと思いますけど、ご参考になれば。

merlionXX
質問者

お礼

なるほど! 最終Itemか最初のItemのどちらが必要かで書き分けるべきなんですね! 理解しました。 ありがとうございました。

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

> 3行も費やして重複のチェックをしなくとも Dictionary については、その通りです。ただ、好みとなっちゃうのかなぁ If Not dic.Exists(sKey) Then   dic.Add Key:=sKey, Item:=vbEmpty End If の方がソースとしてわかりやすい気がするけど。 Item を無視してよいなら多分、      dic(sKey) = vbEmpty の方が高速でしょう。

merlionXX
質問者

お礼

KenKen_SPさま、いつもありがとうございます。 dic(sKey) = vbEmpty とはItemには何も入れないという意味というように理解してよろしいでしょうか? Sub test03() Dim myDic As Object Dim myAr(), myAr2() Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To 7 myDic(Cells(i, 1).Value) = vbEmpty Next i myAr() = myDic.Keys myAr2() = myDic.Items MsgBox Join(myAr()) & vbLf & Join(myAr2()) End Sub で試したら、Join(myAr2())が0の行列になりましたので。 > ソースとしてわかりやすい気がするけど。 確かにそうですね、myDic(Cells(i, 1).Value) = Cells(i, 2).Value って書いたら、後で見て自分でもわからなくなりそうです。 (^^;;

関連するQ&A

  • 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ペコッ

  • エクセルでDictionaryオブジェクト

    メリークリスマス! とはいうものの仕事が終わりません。 これまでエクセルでDictionaryオブジェクトを利用し、AN列にある人名データをKeyにしてT列にある金額の集計を行っていました。 条件 AN列のデータには重複するものが多いが同姓同名は存在しない。 T列には必ず数値が入力されている。 AN列にある人名ごとにT列にある金額の集計を行う。 省略してますが以下のようなコードです。 Sub test01()   Dim myDic As Object   Dim x As Long   Dim myC As Range   Dim ws As Worksheet   Set myDic = CreateObject("Scripting.Dictionary")   x = Cells(Rows.Count, "AN").End(xlUp).Row   For Each myC In Range("AN1:AN" & x) '受取人名列     If Not myDic.Exists(myC.Value) Then       myDic.Add myC.Value, Cells(myC.Row, "T").Value 'T列の金額     Else       myDic(myC.Value) = myDic(myC.Value) + Cells(myC.Row, "T").Value '金額を加算     End If   Next   Set ws = Worksheets.Add(After:=ActiveSheet)   With ws '新規ワークシート     .Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.keys) 'A列にデータ     .Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Items) 'B列に結びつけ金額データ   End With   Set myDic = Nothing End Sub これでうまくできていたのですが、今回新しい条件が加わり、頭を悩ませております。 新たな条件とは、同じ表のN列にあるコード(数字8桁)のうち、例えば77777777のものがあれば、追加したワークシートのC列にフラグをたてるというものです。 どのようにすればできるでしょうか? よろしくお願いいたします。

  • エクセルVBAでDictionaryオブジェクトについて

    エクセル2000です。 例えばA列に国名、B列に都市名、C列に団体名が切れ目なく並ぶリストがあります。 表はA列を基準にソートされています。 A列の同じ国名が終わる行のD列の1個のセルに、そこまでのC列で出てきた団体名を重複しないでカンマ区切りで表示しようと思います。 そのため、下記のようにDictionaryオブジェクトで団体名の重複を防いでいます。 Sub Test2() Dim i As Long Dim myStr As String Dim myDic Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row If myDic.exists(Cells(i, "C").Value) = False Then myStr = myStr & Cells(i, "C").Value & "、" myDic.Add Cells(i, "C").Value, "" End If If Cells(i, "A") <> Cells(i + 1, "A") Then Cells(i, "D") = Left(myStr, Len(myStr) - 1) myStr = "" End If Next i End Sub 問題は、国をまたいで同じ団体名が出てきた場合、すでに上の方の国で変数myDicに登録されているため、登録されないということです。 上記コードでD列に変数myStを転記し、myStrを = ""にした時に、変数myDicの方もクリアしてしまえばいいとは思うのですが、どうやってクリアしたらよいのかわかりません。 ご教示くださいませ。 こんな感じにしたいのです。 日本 東京 abc 日本 横浜 bbc 日本 大阪 bbc 日本 名古屋 abc 日本 札幌 abc bbc、abc 韓国 ソウル kbc 韓国 プサン kkc 韓国 テグ kbc 韓国 テジョン abc 韓国 インチョン bbc kbc、kkc、bbc、abc 北朝鮮 ピョンヤン xxc 北朝鮮 テポドン xxc xxc 中国 北京 ccc 中国 南京 ccc 中国 上海 abc 中国 大連 kbc ccc、abc、kbc 表が上手く表示されませんが、各国名の最終行のB列都市名の右の1個はC列の団体名で、その右にくっついて見えるのがD列のカンマ区切りのデータです。

  • エクセルVBAでTransposeの不思議

    MS Officeのエクセル2000です。 下記Sub test01はRange("A1:I1")に文字列を入力し、一旦配列に取り込んでからワークシートに貼り付けるものです。 試験用のコードですので意味はありません。 このコードで255文字まではまったく問題はありません。 ところが、256文字以上の場合、横に貼り付けは問題ないのですが、 Transposeで縦に変換すると型が一致しません。(Error 13)となります。 どうしてでしょうか? 試行錯誤の結果、Sub test02のように一旦横に貼ったデータをコピーしてTransposeして貼り付けるのは大丈夫のようですので不思議でしょがありません。 またこの方法は列数256より要素が多い配列には使えないので解決策にはなりません。 ご教示くださいませ。 Sub test01() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A5").Resize(UBound(myAr, 2)).Value = Application.Transpose(myAr) '256文字の場合エラー End With End Sub Sub test02() Dim myAr As Variant Dim i As Integer, n As Integer n = 256 '文字数 With ActiveSheet .UsedRange.ClearContents For i = 1 To 9 .Cells(1, i).Value = Application.Rept(Left(.Cells(1, i).Address(0, 0), 1), n) Next myAr = .Range("A1:I1").Value .Range("A3").Resize(, UBound(myAr, 2)).Value = myAr .Range("A3").Resize(, UBound(myAr, 2)).Copy .Range("A5").PasteSpecial Paste:=xlValues, Transpose:=True '256文字の場合もOK Application.CutCopyMode = False End With End Sub

  • 以下のデータがあり、これを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

    エクセル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で重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 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

  • エクセルVBAで配列の追加

    エクセル2000です。 1行4列のセル範囲のデータを配列に取り込んで、後から別の1行4列のセル範囲のデータを配列に追加し、2次元配列として吐き出そうと思います。 最初の範囲がA1:D1、追加範囲がA4:D4とした場合、こんな不細工なコードになってしまいました。 これでも動きますが、どう修正すべきでしょうか? Sub test() Dim myAr() myAr = Application.Transpose(Range("A1:D1").Value) ReDim Preserve myAr(1 To 4, 1 To 2) For i = 1 To 4 myAr(i, 2) = Cells(4, i) Next i Range("F1").Resize(UBound(myAr, 2), UBound(myAr, 1)).Value = Application.Transpose(myAr) End Sub

  • エクセルVBAで配列内に空白データを入れる場合

    エクセル2000です。 ある大きな表のうち、0値を非表示ではなく完全に削除するために以下のようなマクロを書いてみました。 一旦配列に取り込んでいるのは高速化のためです。 これで見た目には目的を達しているのですが、実際には0値が長さ0の文字列に変わっただけで完全な空白にはなっていません。 配列にとりこまず、セルをループして0値のセルをClearすれば解決するのはわかるのですが、ほかにいい方法はないでしょうか? Sub TEST0値() Dim myAr With ActiveSheet x = .Range("A" & Rows.Count).End(xlUp).Row myAr = .Range("A4:AP" & x).Value For i = LBound(myAr, 1) To UBound(myAr, 1) For n = LBound(myAr, 2) To UBound(myAr, 2) If myAr(i, n) = 0 Then myAr(i, n) = "" Next n Next i .Range("A4:AP" & x).Value = myAr End With End Sub

  • VBA アプリケーション・オブジェクト定義のエラー

    ある行と別の行と同じ内容の文章が入っている場合、それを削除するマクロをくんでいますが、 アプリケーション・オブジェクト定義のエラーとのことで作動してくれません。。。 以下のような記述なのですが、アドバイスをいただけたら幸いです。 よろしくお願いいたします。 Sub 重複削除() Dim dataend Cells(Rows.Count, 5).End(xlUp).Select dataend = ActiveCell.Row For i = 2 To dataend - 1 For k = 1 To dataend - i If Cells(2, i).Value = Cells(2, i + k).Value Then '''''''''''''''''''''ここでひっかかる Rows(i + 1).Select Selection.Delete End If Next Next End Sub

専門家に質問してみよう