[[20250210140807]]　『Dictionary 登録されていないKeyのItemがきえてし』（Thomas）　ページの最後に飛ぶ

『Dictionary 登録されていないKeyのItemがきえてしまう』（Thomas）

Dictionaryで製品リストからある年月のみの値を抽出したく、下記コードを作成したのですが、抽出したい年月以外のItemが消えてしまいます。もしよろしければ抽出したい年月にのセルに入っているItemをそのままのこしておくようにするコードをお教え頂きたくお願い致します。

<File1 Sheet1>
Part No 2025 Jan 2025 Feb 2025 Mar ～ 2025 Dec

  A         1       11        21              121   
  B         2       12        22              122   
  C         3       13        23              123   
  D         4       14        24              124   
  E         5       15        25              125   
  F         6       16        26              126   
  G         7       17        27              127

<File2 Sheet2>
Part No 2024 Jan 2024 Feb 2024 Mar ～ 2025 Jan 2025 Feb

  A                                            1        11   
  B                                            2        12   
  C                                            3        13   
  D                                            4        14   
  E                                            5        15   
  F                                            6        16   
  G                                            7        17   
(下記コードを実行すると元々2024年に入っていたItemが全て消えてしまう)

Sub test()
Dim a, b As Long
Dim KeyA, KeyB, KeyC, KeyD, KeyE
Dim Dic As Object
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim WS1 As Worksheet
Dim WS2 As Worksheet

Set WB1 = Workbooks("Book1")
Set WB2 = Workbooks("Book2")
Set WS1 = WB1.Sheets("Sheet1")
Set WS2 = WB2.Sheets("Sheet2")
Set Dic = CreateObject("Scripting.Dictionary")

a = 8
Do Until WS1.Cells(a, 4).Value = ""
KeyA = WS1.Cells(a, 4).Value
Set Dic(KeyA) = CreateObject("Scripting.Dictionary")

b = 17
Do Until WS1.Cells(5, b).Value = ""
KeyB = WS1.Cells(5, b).Value
Set Dic(KeyA)(KeyB) = CreateObject("Scripting.dictionary")

Dic(KeyA)(KeyB) = WS1.Cells(a, b).Value

b = b + 1
Loop
a = a + 1
Loop

a = 7
Do Until WS2.Cells(a, 1).Value = ""
KeyA = WS2.Cells(a, 1).Value

b = 3
Do Until WS2.Cells(6, b).Value = ""
KeyB = WS2.Cells(6, b).Value

On Error Resume Next
WS2.Cells(a, b).Value = Dic(KeyA)(KeyB)
On Error GoTo 0
b = b + 1
Loop
a = a + 1
Loop
End Sub

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 よくわかりませんが、
 Set Dic(KeyA)(KeyB) = CreateObject("Scripting.dictionary")
 Dic(KeyA)(KeyB) = WS1.Cells(a, b).Value
 とされています。
 Dic(KeyA)(KeyB)はdictionaryのはずなのに、キーを指定せずに値を直接代入しています。
 この意図はどういうものですか？

 ついでにインデントを付けないのは、何か美学のようなものがあるのでしょうか。
 あなた自身が読みにくくありませんか？

（xyz） 2025/02/10(月) 15:24:04

ご指摘頂いた "キーを指定せずに値を直接代入..."ですが、自分自身でネットで色々と調べてトライ&エラーを繰り返した結果このコードでできたので、このまま使っています。
インデントもどうしても毎回忘れてしまうので、次回よりつけるようにいたします。
正直まだまだ知識が無く、理論的にこのコードにしているわけでは御座いませんので、お教え頂きたくお願い致します。
（Thomas） 2025/02/10(月) 15:48:56

 現状のコードにこだわらず、まず、そもそもされたいこと自体を説明していただけますか？
 その内容によっては、別のもっと有効なアプローチが提示されるかもしれません。（控え目に言っています）
 # ちょっと外出しますので、やりとりはできません。

（xyz） 2025/02/10(月) 15:53:16

やりたいことを箇条書きにしますと、

File1にはPart Noと2025年1月-12月までのデータ
File2にはFile1と同じPart Noと2024年1月-2025年12月までの表(2024年には既にデータが入っている)
File1のデータをFile2に抽出したい
但しこのコードを使うと2025年1月～のデータは抽出できるが、File2の2024年1月-12月のデータが消えてしまう

どこが間違いなのかお教え頂きたいのですが、何分知識があまりなく、違う方法でお教え頂くと理解が追いつかない可能性があるので、できればこのコードを改造して頂きたくお願い致します。

（Thomas） 2025/02/10(月) 16:07:52

 シートのレイアウトが提示されてはいますが、セルの位置がよく分からないです。

 行番号(1,2,3,・・）と列番号(A,B,C、・・)を補って貰えませんか？

 特に　以下のセルはループの基点らしいですが、レイアウトのどのセルに当たるのですか？
　　WS1.Cells(8, 4)　、WS1.Cells(5, 17)
  　WS2.Cells(7, 1)　、WS2.Cells(6, 3)

（半平太） 2025/02/10(月) 16:51:53

 おそらく...

 1)
 >Set Dic(KeyA)(KeyB) = CreateObject("Scripting.dictionary")
 は不要かと。

 2)
 >On Error Resume Next
 >WS2.Cells(a, b).Value = Dic(KeyA)(KeyB)
 >On Error GoTo 0

は

 If Dic.Exists(KeyA) Then
     If Dic(KeyA).Exists(KeyB) Then WS2.Cells(a,b).Value=Dic(KeyA)(KeyB)
 End If
（jindon） 2025/02/10(月) 17:04:37

みな様ご助言頂きまして有難うございます。
jindon様から頂いたコードでうまくいきました。
Set Dic(KeyA)(KeyB) = CreateObject("Scripting.dictionary")を削除してもうまくいきました。
但しこの2点についてまだ理解ができておりませんので、どうしてこうなるのかもう少し考えてみます。
考えた後にまた質問させて頂くかもしれませんので、その際は再度ご助言頂ければ幸いです。

（Thomas） 2025/02/10(月) 17:42:32

 全体としてどんな作業かやや不明ですので、後続の作業で辞書が必須なのか知りませんが、
 少なくとも 表の転記だけなら、
 ・FILLE2のPART列値が FILE1のPART列の何行目にあるかの検索は、普通にMATCHを使って求め、
 ・FILE2の各行毎に、対応するFILE1の行の1年の領域をまとめて単にコピーする
 ことでよいと思います。
 入れ子にした辞書を使ってもよいですが、通常の方法のほうが間違いないと思います。
 あえて新しいことに挑戦ということでしょうか。

 jindonさんのご指摘のとおりかと思いました。

 # バッティングしました。
（xyz） 2025/02/10(月) 17:48:34

 半平太さんの確認のためのコメントへの回答は無いのですか？
 私も継続して事象確認したいと思っています。

（xyz） 2025/02/10(月) 18:21:29

 補足説明するとすれば以下のようになるでしょう。

 > On Error Resume Next
 > WS2.Cells(a, b).Value = Dic(KeyA)(KeyB)
 > On Error GoTo 0
 では、keyA（PART NO）は存在するが、2024年のKeyBは存在しません。
 一般に辞書というものは、
    ・キーとItemを設定しない状態で単に参照すると、そのキーが作られ、EmptyというItemを返すという
       性質があります。
    ・また、結果として、Dic(KeyA)という辞書は、KeyB をキー、EmptyをItem に持つ状態で残ります。

 したがって、
 WS2.Cells(a, b).Value = Dic(KeyA)(KeyB)
 はエラーにならず、単に 
 WS2.Cells(a, b).Value = Empty
 を実行したことになります。（Emptyは""とみなせます。なお、数値との演算では0として機能します。）

 この結果、「シートに設定ずみの2024年データは消え去る」という結果になります。
（xyz） 2025/02/10(月) 19:04:55

コメント返信：

[ 一覧(最新更新順) ]

[[20250210140807]] 『Dictionary 登録されていないKeyのItemがきえてし』（Thomas） ページの最後に飛ぶ

[[20250210140807]]　『Dictionary 登録されていないKeyのItemがきえてし』（Thomas）　ページの最後に飛ぶ