[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Dictionaryで3つ以上のKeyに対するItemの抽出方法(再)』（Thomas）
Dictionaryで列のKeyと行のKeyと行のKeyの3つのKeyにマッチしたItemをアウトプットしたく、下記コードを作り実行したのですが、うまくいかないです。やりたいことを具体的ご説明すると、会社で使う見積のデータベースとそのコスト一覧をSheet1とSheet2に作りたく、Sheet1のデータベースの1列目に1から1,000位までの番号、1行目に工程名(成型・板金・洗浄・メッキ・塗装・組立等々・検査・梱包)、2行目にタクト・処理数・人件費・コストがあります。例としてB1・C1・D1・E1に成型、F1・G1・H1・J1に板金….と記載し、その下の行のB2はタクト C2は処理数 D2は人件費 E2はコストが入ります(F2はタクト G2は処理数 H2は人件費 J2はコスト…..)。Sheet2も同じく1列目に番号、1行目に工程名、2行目にタクト等が入っておりますが、必要に応じて抽出結果を変更いたします。以前同じ内容を[[20221201120517]]にて質問させて頂き、2次元でのやり方を教えて頂き、今はそのやり方を使っているのですが、どうしてもどこが問題なのかまた3次元や多次元の入れ子のやり方を知っておきたく再度質問させて頂きました。以前3次元にする意味がないとのご指摘を頂いておりますが、もしどなたかご教示頂ける方がいらっしゃいましたら、お手数をお掛けしますがよろしくお願い致します。
Sub Test()
Dim Dic As Object
Dim j As Long
Dim k As Long
Dim n As Long
Dim lastrow As Long
Dim lastcolumn As Long
Dim lastcolumn2 As Long
Dim keyR As String
Dim keyC As String
Dim keyW As String
Dim ws01 As Worksheet, ws02 As Worksheet
Set Dic = CreateObject("scripting.dictionary")
Set ws01 = Worksheets("Sheet1")
Set ws02 = Worksheets("Sheet2")
lastrow = ws01.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ws01.Cells(1, Columns.Count).End(xlToLeft).Column
lastcolumn2 = ws01.Cells(2, Columns.Count).End(xlToLeft).Column
For j = 3 To lastrow
keyR = ws01.Cells(j, 1).Value
If Not Dic.exists(keyR) Then
Set Dic(keyR) = CreateObject("scripting.dictionary")
End If
For k = 2 To lastcolumn
keyC = ws01.Cells(1, k).Value
Dic(keyR)(keyC) = ws01.Cells(j, k).Value
For n = 2 To lastcolumn2
keyW = ws01.Cells(2, n).Value
Dic(keyR)(keyC)(keyW) = ws01.Cells(j, k).Value
Next
Next
Next
lastrow = ws02.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ws02.Cells(1, Columns.Count).End(xlToLeft).Column
lastcolumn2 = ws02.Cells(2, Columns.Count).End(xlToLeft).Column
For j = 3 To lastrow
keyR = ws02.Cells(j, 1).Value
If Dic.exists(keyR) Then
For k = 2 To lastcolumn
keyC = ws02.Cells(1, k).Value
For n = 2 To lastcolumn2
keyW = ws02.Cells(2, n).Value
If Dic(keyR).exists(keyC) Then
ws02.Cells(j, k).Value = Dic(keyR)(keyC)(keyW)
End If
Next
Next
End If
Next
Set Dic = Nothing
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞
Sheet1とShee2はどう違いますか？ また、dictionaryを使う必要性は何ですか？ どこに魅力を感じていますか？
# 余談ですが、それにしても原稿用紙に文字を埋めている感じですね。 # 日頃、他人に説明する機会に、箇条書きとか使わないのですか？ （xyz） 2023/06/28(水) 20:34:42
コーディングの課題としては、少なくともインデントのネスト構造は見直してみよう
（とおりすがり） 2023/06/28(水) 20:54:28
(1) 申し出に仮に回答するとして、 dictionaryへの書き込みの部分だけ書くとすればこうですか？
Sub Test()
Dim ws01 As Worksheet
Dim ws02 As Worksheet
Dim Dic As Object
Dim lastrow As Long
Dim lastcolumn As Long
'Dim lastcolumn2 As Long
Dim keyR As String
Dim keyC As String
Dim keyW As String
Dim j As Long
Dim k As Long
Set Dic = CreateObject("scripting.dictionary")
Set ws01 = Worksheets("Sheet1")
Set ws02 = Worksheets("Sheet2")
lastrow = ws01.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ws01.Cells(1, Columns.Count).End(xlToLeft).Column
'lastcolumn2 = ws01.Cells(2, Columns.Count).End(xlToLeft).Column
For j = 3 To lastrow
keyR = ws01.Cells(j, 1).Value
If Not Dic.Exists(keyR) Then
Set Dic(keyR) = CreateObject("scripting.dictionary")
End If
For k = 2 To lastcolumn
keyC = ws01.Cells(1, k).Value
keyW = ws01.Cells(2, k).Value
If Not Dic(keyR).Exists(keyC) Then
Set Dic(keyR)(keyC) = CreateObject("scripting.dictionary")
End If
Dic(keyR)(keyC)(keyW) = ws01.Cells(j, k).Value
Next
Next
(2) 今のデータはすでに整形ができているので、 dictionaryにする必要はなく、あとは集計するだけのように思います。
もし下記のような元データであれば、 番号 種類 項目 数値 (データはむろん仮のものです） 1 成型 タクト 1 1 成型 処理数 2 1 成型 人件費 3 1 成型 コスト 4 1 板金 タクト 5 1 板金 処理数 6 1 板金 人件費 7 1 板金 コスト 8 2 成型 タクト 9 2 成型 処理数 10 2 成型 人件費 11 2 成型 コスト 12 2 板金 タクト 13 2 板金 処理数 14 2 板金 人件費 15 2 板金 コスト 16 データの組み立て方法としてないこともないかもしれませんが、 こういう場合は、むしろピボットテーブルの活用場面のように思えます。 色々な道具がありますので、取捨選択をされたらいかがでしょうか。
（xyz） 2023/06/28(水) 21:20:22
Dictionaryの理解は大丈夫でしょうか？ フォルダの階層をイメージすると理解しやすいかな。 以下イメージ
Key番号- Key工程名 - Item工程名
L Key成型 - Keyタクト - Itemタクト
L Key処理数 - Item処理数
L Key人件費 - Item人件費
L Keyコスト - Itemコスト
L Key板金 - 上記と同じ
L Key洗浄 - 上記と同じ
L Keyメッキ - 上記と同じ
L Key塗装 - 上記と同じ
L Key組立等々 - 上記と同じ
L Key検査 - 上記と同じ
L Key梱包 - 上記と同じ
好きなように取得して貼り付けるだけ、のような。
（tkit） 2023/06/29(木) 09:19:21
こんなデータですか？
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U]
[1] |番号|成型 |成型 |成型 |成型 |板金 |板金 |板金 |板金 |洗浄 |洗浄 |洗浄 |洗浄 |メッキ|メッキ|メッキ|メッキ|塗装 |塗装 |塗装 |塗装
[2] |番号|タクト|処理数|人件費|コスト|タクト|処理数|人件費|コスト|タクト|処理数|人件費|コスト|タクト|処理数|人件費|コスト|タクト|処理数|人件費|コスト
[3] | 1| | | | | | | | | | | | | | | | | | | |
[4] | 2| | | | | | | | | | | | | | | | | | | |
[5] | 3| | | | | | | | | | | | | | | | | | | |
[6] | 4| | | | | | | | | | | | | | | | | | | |
[7] | 5| | | | | | | | | | | | | | | | | | | |
[8] | 6| | | | | | | | | | | | | | | | | | | |
[9] | 7| | | | | | | | | | | | | | | | | | | |
[10]| 8| | | | | | | | | | | | | | | | | | | |
[11]| 9| | | | | | | | | | | | | | | | | | | |
[12]| 10| | | | | | | | | | | | | | | | | | | |
[13]| 11| | | | | | | | | | | | | | | | | | | |
であれば、こんな感じでしょうか
Sub sample()
Dim ws As Worksheet
Dim iCol As Long, iRow As Long
Dim keyR, keyC, keyW
Dim Dic As Dictionary
Set Dic = CreateObject("Scripting.Dictionary")
Set ws = Worksheets(1)
For iRow = 3 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
If Not Dic.Exists(keyR) Then
Dic.Add keyR, CreateObject("Scripting.Dictionary")
End If
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
keyW = ws.Cells(2, iCol).Value
If Not Dic(keyR).Exists(keyC) Then
Dic(keyR).Add keyC, CreateObject("Scripting.Dictionary")
End If
Dic(keyR)(keyC)(keyW) = ws.Cells(iRow, iCol).Value
Next
Next
Set ws = Worksheets(2)
For iRow = 3 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
keyW = ws.Cells(2, iCol).Value
ws.Cells(iRow, iCol).Value = Dic(keyR)(keyC)(keyW)
Next
Next
End Sub
（´・ω・`） 2023/06/29(木) 10:12:17
私が書いたコードはxyzさんのとほぼほぼ同じでしたね 他の回答者さんの書き込みちゃんとを読んでないことがバレちゃいました すんません （´・ω・`） 2023/06/29(木) 11:51:33
1点目はiCol = 2 to ws.Cells(2,Columns.Count).End(xlToleft).columnは2行目を指定していますが、KeyC=ws.Cells(1,iCol).valueでは1行目を指定しています。iColは2行目なのにKeyCは1行目を指定しているので、矛盾してしまうのでは思います。この解釈としては、iColで行を指定していても、後でKeyを定義する際に変更可能という事でしょうか？
2点目は入力と出力について、入力・出力共にKeyは同じ名前KeyC KeyR KeyWを使用していますが、厳密に言うとシート1のKeyRとシート2のKeyRでは違う箇所があります。(例としてF1は板金ですがシート2のF1はゴムとなっている等々) Keyを同じ名前にする意味は、既に登録されているシート1のKeyCの値とシート2のKeyCの値が同じであれば登録されている値が抽出されるようにする為に同じKeyでなければならないという理解でよろしいでしょうか？
3点目は頂きましたコードを基にKeyを1つ追加して4次元のコードを以下の様に作ったのですが、うまくいきませんでした。恐れいりますがどのあたりが問題なのかをご教示頂けます様お願い致します。
Sub sample()
Dim ws As Worksheet
Dim iCol As Long, iRow As Long
Dim keyR, keyC, keyW, KeyA
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set ws = Worksheets(1)
For iRow = 4 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
If Not Dic.Exists(keyR) Then
Dic.Add keyR, CreateObject("Scripting.Dictionary")
End If
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
If Not Dic(keyR).Exists(keyC) Then
Dic(keyR).Add keyC, CreateObject("Scripting.Dictionary")
End If
keyW = ws.Cells(2, iCol).Value
If Not Dic(keyR)(keyC).Exists(keyW) Then
Dic(keyR)(keyC).Add keyW, CreateObject("Scripting.Dictionary")
End If
KeyA = ws.Cells(3, iCol).Value
Dic(keyR)(keyC)(keyW)(KeyA) = ws.Cells(iRow, iCol).Value
Next
Next
Set ws = Worksheets(2)
For iRow = 4 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
keyW = ws.Cells(2, iCol).Value
KeyA = ws.Cells(3, iCol).Value
ws.Cells(iRow, iCol).Value = Dic(keyR)(keyC)(keyW)(KeyA)
Next
Next
End Sub
（Thomas） 2023/07/07(金) 10:31:47
質問への回答ではありませんが、 どんなコードを作るのか、その目的があって、シートのデータレイアウトがあって、 目的とデータに合致したコードを作る必要があります。
目的とデータのレイアウトを提示してください （´・ω・`） 2023/07/07(金) 11:57:11
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I]
[1] |番号|成型 |成型 |成型 |成型 |板金 |板金 |板金 |板金
[2] |番号|タクト|処理数|人件費|コスト|タクト|処理数|人件費|コスト
[3] |番号|工場１|工場１|工場１|工場１|工場１|工場１|工場１|工場１
[4] | 1| | | | | | | |
[5] | 2| | | | | | | |
[6] | 3| | | | | | | |
（Thomas） 2023/07/07(金) 14:44:32
1点目の質問 そのコードは最終列を取得して、その列までループするコードです。 1行目も２行目も最終列は同じはずなので、1でも２でもかまいません。
2点目の質問 KeyC KeyR KeyW という変数名を入力と出力で同じものを使用しているという ことに対する疑問でしょうか。 変数は単なる入れ物ですので、中身は代入するたびに上書きされます。その中身を DictionaryのKeyとして使用しています。変数名が同じでもなんの問題もありません。 入力シートも出力シートも同じwsという変数を使用していますが、 なんら問題ないのと同じことです。
3点目の質問 当方でサンプルを作成して試してみましたが、正常にSheet2に結果が出力されました。
（hatena） 2023/07/07(金) 15:56:34
こんにちは。 > 3点目は頂きましたコードを基にKeyを1つ追加して4次元のコードを以下の様に作ったのですが、うまくいきませんでした。 私も問題なく実行できました。 うまくいかない、の内容をきちんと説明してください。
・エラーになるなら、なんというエラーが、どこで発生したのか。
・想定と異なる結果になったのなら、
・想定はこうだが、
・こんなことになってしまう
という説明が必要です。
（xyz） 2023/07/07(金) 16:07:41
ちなみに、 [[20221201120517]] でも回答しましたが、Dictionaryを入れ子にするメリットは まったくないと思います。
下記のようにキーを連結して使用すれば一つのDictionaryですみます。 入れ子にすれば、コードが複雑になるし、重くなるし、メリットは一つもありません。
Sub sample1()
Dim ws As Worksheet
Dim iCol As Long, iRow As Long
Dim keyR, keyC, keyW, KeyA
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set ws = Worksheets(1)
For iRow = 4 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
keyW = ws.Cells(2, iCol).Value
KeyA = ws.Cells(3, iCol).Value
Dic(keyR & ";" & keyC & ";" & keyW & ";" & KeyA) = ws.Cells(iRow, iCol).Value
Next
Next
Set ws = Worksheets(2)
For iRow = 4 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
keyR = ws.Cells(iRow, 1).Value
For iCol = 2 To ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
keyC = ws.Cells(1, iCol).Value
keyW = ws.Cells(2, iCol).Value
KeyA = ws.Cells(3, iCol).Value
ws.Cells(iRow, iCol).Value = Dic(keyR & ";" & keyC & ";" & keyW & ";" & KeyA)
Next
Next
End Sub
（hatena） 2023/07/07(金) 16:10:17
私もそのように思います。
既に指摘がありますように、私も目的（というかユースケースというか）を明確にすることが 重要なことだと思っています。
単なる転記なら、そんな多次元のものを使う必要はないです。 もともとシートという二次元に収まっているものだからです。
ピボットテーブルに類似の機能を再発明（"車輪の再発明")でもしようというのでしょうか。 簡単で軽いもので容易にコード対応できるのであれば、ピボットテーブル機能などというものを MS社が提供するはずがありません。
（xyz） 2023/07/07(金) 16:18:46
シート上でめちゃくちゃ長い式組んじゃって何処でエラーになるのかワカラン。ていうヤツと一緒ですね。 ステップ実行した時に中身が確認出来る組み方ってのをやった方がいいです。(せめてデバッグ中だけでも)
まぁコードの問題というか、データ型エラーなんだから内容に由来する訳ですし、 この段階で他人に原因尋ねるのは無茶は話ですよ。 ちゃんと変数準備して順番に値を取り出して行けば、ある程度ご自分で原因見えてくるんじゃありませんかね?
（白茶） 2023/07/07(金) 19:54:41
白茶さんのご意見に同意します。 回答者がわでは再現しないことなので、ご自身で調査いただくしかないですね。 あらゆる可能性を回答者が想定するなんていう無理は、期待しないでください。 （xyz） 2023/07/07(金) 22:19:02
少し前に、こんな発言がありました。 > 2点目は入力と出力について、入力・出力共にKeyは同じ名前KeyC KeyR KeyWを使用していますが、 > 厳密に言うとシート1のKeyRとシート2のKeyRでは違う箇所があります。 > (例としてF1は板金ですがシート2のF1はゴムとなっている等々)
よもやとは思いますが、上記のケースで、そのままのコードを実行したということですか？ もしそうなら、そりゃあエラーになりますよ。キーが無いんですから。 キーがあるかどうかのチェックが必要でしょう。
一番大雑把には、すべてのキー集合単位で存在チェックすることですが、正確にするなら、 それぞれの階層単位で、キーが存在するかどうかをチェックする必要があるでしょうね。 （xyz） 2023/07/08(土) 07:26:27
同じデータでやって、私のではうまくいって、 質問者さんのではエラーになるということでしょうか。
おそらくxyzさんが指摘されたように、転記元のキーが出力先に存在しない のが原因でしょうね。 出力先に存在しないキーをいれて実行したら同じエラーがでましたので。
ws.Cells(iRow, iCol).Value = Dic(keyR)(keyC)(keyW)(KeyA)
で keyR が存在しない場合、Dic(keyR) のItemは空(Empty)になりますので、 Dic(keyR)(keyC) でエラーになります。以下のキーも同じです。
対策もxyzさんが指摘されているように Exists ですべてのキーの 存在チェックをするか、On Error Resume Nextでエラーを無視するかですね。
キーが増えると存在チェックも増えるので、On Error Resume Next が シンプルでいいと思います。
On Error Resume Next ws.Cells(iRow, iCol).Value = Dic(keyR)(keyC)(keyW)(KeyA) On Error Goto 0
私のコードでエラーにならないのは、
ws.Cells(iRow, iCol).Value = Dic(keyR & ";" & keyC & ";" & keyW & ";" & KeyA)
で存在しないキーの場合、ItemはEmptyになりますが、それがセルに代入される、 つまり空欄のままということでエラーにはなりません。 （hatena） 2023/07/08(土) 10:25:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.