スキルアップ・問題解決なら、モーグにおまかせ！

大変申し訳ございませんが、以下の結果を表示させる処理のご教示を
お願いできないでしょうか。
 
【抜きシート】
子図番　　　作業時間
1P015-1-KA　　10
2P064-1-KA　　20
2P064-1-KI　　10
 
 
【曲げシート】
子図番　　　作業時間
1P015-1-KA　　10
2P064-1-KA　　30
2P064-1-KI　　20
 
 
【構成シート】
親図番　　　子図番　　　　抜き　　曲げ
1P015-1　　　1P015-1
1P015-1　　　1P015-1-KA　　A
2P064-1　　　2P064-1
2P064-1　　　2P064-1-KA　　A　　　　A
2P064-1　　　2P064-1-KI　　 　　　　A
 
　　　　　　↓
 
 
【結果シート】（現状）
図番　　　　全時間　　　　抜き　　曲げ
1P015-1　　　　10
2P064-1　　　　70
 
 
【結果シート】（望んでいる結果）
図番　　　　全時間　　　　抜き　　曲げ
1P015-1　　　　10　　　　　10
2P064-1　　　　70　　　　　20　　　50
 
 
【抜きシート】、【曲げシート】の子図番が【構成シート】の親図番に
紐づいて、"抜き"、あるいは"曲げ"に該当する場合（Aが表示）、
親図番の全時間に加算していきます。
そして、同時に"抜き"、あるいは"曲げ"の時間単位でも集計を行いのです。
 
 
以下が現時点のコードです。
 
Dim ko As Worksheet, sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim d1 As Object, d2 As Object, dTotal As Object
Dim parent As String, child As String, s1 As String, s2 As String
Dim k As Long
Dim total As Double
 
Set ko = ThisWorkbook.Sheets(3)
Set sh1 = ThisWorkbook.Sheets(4)
Set sh2 = ThisWorkbook.Sheets(5)
Set sh3 = ThisWorkbook.Sheets(6)
 
'抜きシートから時間を取得
 Set d1 = CreateObject("Scripting.Dictionary")
 With sh2
     For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        d1(.Cells(k, "A").Value) = .Cells(k, "B").Value
     Next k
 End With
 
'曲げシートから時間を取得
 Set d2 = CreateObject("Scripting.Dictionary")
 With sh3
     For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        d2(.Cells(k, "A").Value) = .Cells(k, "B").Value
     Next k
 End With
  
 '構成シートより図番の合計時間を集計
 Set dTotal = CreateObject("Scripting.Dictionary")
 With ko
     For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
         parent = .Cells(k, 1) '親図番
         child = .Cells(k, 2) '子図番
         s1 = .Cells(k, 3) '抜き
         s2 = .Cells(k, 4) '曲げ
          
         total = 0
         If s1 <> "" Then total = d1(child)
         If s2 <> "" Then total = total + d2(child)
     
         dTotal(parent) = dTotal(parent) + total
     Next k
 End With
     
'結果をシートに転記
 sh1.Range("A1:D1") = Array("図番", "全時間", "抜き", "曲げ")
 sh1.Range("A2").Resize(dTotal.Count, 1) _
         = Application.Transpose(dTotal.keys)
 sh1.Range("B2").Resize(dTotal.Count, 1) _
         = Application.Transpose(dTotal.items)
 
 
【結果シート】に全時間は表示はできますが、【構成シート】の親図番に
紐づく子図番の各工程毎の合計で止まっています。
 
以前、参考のご教示をして頂きましたが、追加で行いたい内容について
調査を行いましたが止まってしまったので、アドバイスのご質問をさせて
頂きました。
よろしくお願い致します。

Dictionary は 基本 2次元であり、2列 の 処理はできますが、3列の処理を行うには テクニックが必要です。
 
コードでも
dTotal(parent) = dTotal(parent) + total
 
としており、
 
右辺 キー： parent に対して
左辺 値 ： 既存の dTotal(parent) と、変数 total の値 の加算値
 
を代入しており、
 
それが、抜き/曲げ どちらの値なのか は、Dictionary には含まれていません。
 
 
図番    時間
1P015-1    10
2P064-1    70
 
は、出来ても
 
図番    抜き    曲げ
1P015-1        
2P064-1        
 
の 構成は、このままでは無理です。
 
Dictionary の構造のまま使うなら
 
[VBA]Dictionary（連想配列）の使い方とテクニック
https://y-moride.com/vba/dictionary.html
 
の様に、多次元の Dictionry を使う必要があます。
 
 
コード自体を提示されたのをそのまま使っていて、
どうやったらどうなるのか理解されていない様にお見受けします。
 
それを 気付けないのであれば、今回は、Dictionary は使わない方が良いと思いますよ。
 
以前の
変換データを利用した行の挿入について
https://www.moug.net/faq/viewtopic.php?t=82296
 
で、データが、10000行 との事ですが、今回は挿入はありませんし
 
一般関数だけでも行けると思います。
作業列を使えるなら、もっと簡単です。
 
シート「構成」

親図番	子図番	抜き	曲げ
1P015-1	1P015-1		
1P015-1	1P015-1-KA	A	
2P064-1	2P064-1		
2P064-1	2P064-1-KA	A	A
2P064-1	2P064-1-KI		A

図番	子図番	抜き	曲げ	抜2	曲2
1P015-1	1P015-1			0	0
1P015-1	1P015-1-KA	A		10	0
2P064-1	2P064-1			0	0
2P064-1	2P064-1-KA	A	A	20	30
2P064-1	2P064-1-KI		A	0	20

Suzu様
お返事ありがとうございます。
「Dictionary」は2次元で、3列の処理が行えない事は理解できました。
この点を解説して頂きありがとうございました。
デバッグのウォッチ式も利用しながら確認を行ないました。
また、まだまだ学習が足りませんが今回、ご質問をさせて頂いたコード内容に
つきましては理解出来ています。
 
しかし、今回の目的である多次元になると、「どうやったらどうなるのか理解
されていない様にお見受けします。」と言うお言葉はSuzu様のおっしゃる通りです。
[VBA]Dictionary（連想配列）の使い方とテクニックをご紹介して頂きましたが、
今回、ご質問をさせて頂いたコードを、どの様に変更を行えばよいのか悩んでいる
のが現状です。
できれば、今後の事を考慮してマスターを行いたいと考えています。
もし、可能であればどの箇所を修正すればよいのかアドバイスを頂けたら幸いです。
よろしくお願い致します。

引用:
「Dictionary」は2次元で、3列の処理が行えない事は理解できました。
この点を解説して頂きありがとうございました。
デバッグのウォッチ式も利用しながら確認を行ないました。

引用:
できれば、今後の事を考慮してマスターを行いたいと考えています。

引用:
もし、可能であればどの箇所を修正すればよいのかアドバイスを頂けたら幸いです。

Suzu様
お返事ありがとうございます。
 
それで、「抜き」なのか「曲げ」なのか を
dTotal の中で、どう判断しようとされたのでしょうか？
 
　⇒　また、間違った内容を申し上げていたらお詫び致しますが今回、
　　　記載させて頂いた現コードの変数を順次確認しました。
 
Dictionry の 構造 で行うとして、先に提示した コンテンツの 具体的に
どこが判らないのでしょうか？
どの箇所修正すれば という発言では、マスターをする意識を感じる事はできません。
 
　⇒　具体性が無く大変申し訳ございません。
　　　過去に記載させて頂いた内容を公開されてお恥ずかしいですが、
　　　「ご自身の考慮の跡が見えません。」と言われても仕方がないです。
　　　しかし、言い訳になりますが、今までに多くの方々にアドバイスを頂き
　　　ました。
　　　参考にサンプルを記載して頂いたコードにつきましては独学になりますが
　　　ネット等を利用して、全て中身を確認させて頂いています。
 
Dictionary は、2列なら簡単です。
基本は、2列しか扱えない事 すら ご存じでは無いように拝見される方に
Dictionary を使う前提の コードを提示しても、とてもマスターできるとは思えません。
 
　⇒　大変申し訳ございません。
　　　今まで利用していた「Dictionary」の件は、改めて学習を行いました。
　　　また、言い訳になりますが、決して何も確認をしないでご質問はさせて頂いて
　　　おりません。
　　　学習は続けていますが、応用力の無さを痛感しています。
　　　恐縮です。
 
再度、先程ご教示を頂いた「[VBA]Dictionary（連想配列）の使い方とテクニック」の
多次元配列について確認します。

全時間 は 抜き計＋曲げ計 で計算できますので、必要なデータは抜き計と曲げ計ですね。
Itemに抜き計と曲げ計という２つのデータが格納できればいいのですが、Itemには配列も格納可能なので、配列にして格納すればいいでしょう。
 
現状のコードをなるべく活かすなら、下記のような感じでしょうか。
 

Public Sub Sample()

    Dim ko As Worksheet, sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim d1 As Object, d2 As Object, dTotal As Object
    Dim parent As String, child As String, s1 As String, s2 As String
    Dim k As Long
    Dim mage As Long, nuki As Long

    Set ko = ThisWorkbook.Sheets(1)
    Set sh1 = ThisWorkbook.Sheets(2)
    Set sh2 = ThisWorkbook.Sheets(3)
    Set sh3 = ThisWorkbook.Sheets(4)

    '抜きシートから時間を取得
    Set d1 = CreateObject("Scripting.Dictionary")
    With sh2
        For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            d1(.Cells(k, "A").Value) = .Cells(k, "B").Value
        Next k
    End With

    '曲げシートから時間を取得
    Set d2 = CreateObject("Scripting.Dictionary")
    With sh3
        For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            d2(.Cells(k, "A").Value) = .Cells(k, "B").Value
        Next k
    End With

    '構成シートより図番の合計時間を集計
    Set dTotal = CreateObject("Scripting.Dictionary")
    With ko
        For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            parent = .Cells(k, 1)    '親図番
            child = .Cells(k, 2)    '子図番
            s1 = .Cells(k, 3)    '抜き
            s2 = .Cells(k, 4)    '曲げ

            If s1 <> "" Or s2 <> "" Then
                If s1 <> "" Then nuki = d1(child) Else nuki = 0
                If s2 <> "" Then mage = d2(child) Else mage = 0
                If dTotal.Exists(parent) Then
                    dTotal(parent) = Array(dTotal(parent)(0) + nuki, dTotal(parent)(1) + mage)
                Else
                    dTotal(parent) = Array(nuki, mage)
                End If

            End If
        Next k
    End With

    '結果をシートに転記
    sh1.Range("A1:D1") = Array("図番", "全時間", "抜き", "曲げ")
    sh1.Range("A2").Resize(dTotal.Count, 1) _
          = Application.Transpose(dTotal.keys)
    sh1.Range("C2").Resize(dTotal.Count, 2) _
          = Application.Transpose(Application.Transpose(dTotal.items))

    With sh1.Range("B2").Resize(dTotal.Count, 1)
        .FormulaLocal = "=C2+D2"
        .Value = .Value
    End With
End Sub

引用:
それで、「抜き」なのか「曲げ」なのか を
dTotal の中で、どう判断しようとされたのでしょうか？
 
　⇒　また、間違った内容を申し上げていたらお詫び致しますが今回、
　　　記載させて頂いた現コードの変数を順次確認しました。

引用:
どことどこの値を比較し、同じだったら ある変数に その値を入れる
こことここの値を比較し、同じだったら また別の変数に そこの値を入れる

回答	
投稿日時: 23/05/24 23:20:25投稿者: simple
ああ、そうでしたね。totalが初期化されていませんでしたね。ケアレスミス。
修正してください。
	
投稿日時: 23/05/24 23:30:45投稿者: ひろまさ
simple様
遅くにご回答を頂きありがとうございます。
恐縮ではございますが、その個所だけでも具体的にご教示をお願いできないでしょうか。
よろしくお願い致します。

回答	
投稿日時: 23/05/24 23:44:54投稿者: simple
え？
       For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            parent = .Cells(k, 1) '親CD
            child = .Cells(k, 2) '子CD
            s1 = .Cells(k, 3) '切断有無
            s2 = .Cells(k, 4) '溶接有無
            total = 0
            If s1 = "有" Then total = dic1(child)
            If s2 = "有" Then total = total + dic2(child)
            dicTotal(parent) = dicTotal(parent) + total
        Next
です。

With ko
  For k = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    parent = .Cells(k, 1) '親図番
    child = .Cells(k, 2) '子図番
    s1 = .Cells(k, 3) '抜き
    s2 = .Cells(k, 4) '曲げ
    If s1 <> "" Then
      If dTotal.Exists(parent) = True Then
        dTotal(parent) = Split(dTotal(parent), ";")(0) + d1(child) & ";" & Split(dTotal(parent), ";")(1)
      Else
        dTotal(parent) = d1(child) & ";0"
      End If
    End If
    If s2 <> "" Then
      If dTotal.Exists(parent) = True Then
        dTotal(parent) = Split(dTotal(parent), ";")(0) & ";" & Split(dTotal(parent), ";")(1) + d2(child)
      Else
        dTotal(parent) = Split(dTotal(parent), ";")(0) & ";" & d2(child)
      End If
    End If
  Next k
End With

'結果をシートに転記
With sh1
  k = dTotal.Count
  .Range("A1:D1") = Array("図番", "全時間", "抜き", "曲げ")
  .Range("A2").Resize(k) = Application.Transpose(dTotal.Keys)
  .Range("B2").Resize(k) = Application.Transpose(dTotal.Items)

  .Range("C2").Resize(k).FormulaR1C1 = "=MID(RC[-1],1,FIND("";"",RC[-1])-1)"
  .Range("D2").Resize(k).FormulaR1C1 = "=MID(RC[-2], Find("";"", RC[-2]) + 1, 100)"
  .Range("C2").Resize(k, 2).Value = sh1.Range("C2").Resize(5, 2).Value

  .Range("B2").Resize(k).FormulaR1C1 = "=RC[1]+RC[2]"
  .Range("B2").Resize(k).Value = sh1.Range("B2").Resize(k).Value
End With

Itemに2つ以上の値を格納するという方法は、配列をつかったり区切り文字で区切ったり、で操作が理解しづらいなら、
一つの値を格納する方法はすでに理解できているので、抜き計を格納するDictionaryと曲げ計を格納するDictionaryをそれぞれ用意して集計していって、それを出力するという方法でもいいでしょう。

# 過去のやりとりまで言及されて恥ずかしい思いですww。
 
Dictionaryにこだわり過ぎかな、というのが第一印象でした。Suzuさんに同感です。

・構成シートに、抜きと曲げの列を追加し、IFとVLOOKUP関数で数値を取得します。
・集計シートの作成には、重複を除いた親図番コードが必要ですが、
  重複排除とかでなんとかなります。
・集計シートに、SUMIF関数を使った集計式を埋め込みます。

お返事が大変遅くなりましたが、今回も多くの方々からアドバイスを頂き
感謝しています。
ありがとうございました。
 
hatena様
現状のコードを活かした内容を記載して頂きありがとございました。
望んでいる結果が表示されました。
記載して頂いたコードを参考に現在、作成中の処理に応用させてみます。
また、きちんと内容を確認させて頂きます。
2回目に頂いたお返事についても同様にチャレンジしてみます。
 
Suzu様
最初にお返事を頂きありがとうございました。
どなたにお聞きしても理解できるようなご質問ができす反省しています。
私自身も書籍を何冊か購入したり、ネットで検索を行い作成していますが、
どうしても分からない場合はご質問をさせて頂いています。
過去に他の方にご質問をさせて頂いた内容を公開されて、どうしたらよいのか
パニックってしまいました。
全て私が悪いのですが、いろいろとアドバイスを頂き感謝しています。
 
simple様
いつもありがとうございます。
また、以前にアドバイスを頂いた件で、ご迷惑をお掛けしてしまいました。
どうお詫びをしていいのか。
最初にsimple様から「Dictionary」をご教示して頂き、とても便利な処理だった
のでこだわりがありました。
hatena様からもアドバイスを頂きましたが、「3つのdictionaryを作る、と問題を
単純化してしまえば、やることが分かりやすくなるのではないかと思います。」の
アドバイスを頭に入れて、チャレンジします。
また、関数についても適宜に利用を考えます。
 
前に進まなくなった時、またアドバイスを頂ければ幸いです。
ありがとうございました。