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

アドバイスを頂きたい事がございます。
書籍やネットで検索できないイレギュラーな処理になりますが、下記の例のように
【商品シート】商品CD1の「B」が、【変換シート】商品CD1の「B」と一致したと
します。
「B」を【変換シート】商品CD2の「い」に変換を行い、【商品シート】に2明細を
挿入して、追加させる事は可能でしょうか。
 
また、時間についても【変換シート】の割合に応じて明細分に分割します。
今回の場合、割合がそれぞれ"0.5"ですので、【商品シート】時間をそれぞれ
”10”と表示させます。
 
例：
■変換シート
商品CD1　　商品CD2　割合
A　　　　　あ
B　　　　　い　　　　0.5
B　　　　　い　　　　0.5
 
 
■商品シート
商品CD1　　時間
B　　　　　20
A　　　　　30
 
　↓結果
 
■商品シート
商品CD1　　時間
い　　　　　10
い　　　　　10
あ　　　　　30
 
-----------------------------------------------------------------------
以下の処理では、
 
Sub henkan()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim i As Long
    Dim k As Long
    Dim l As Double
 
    Set Sh1 = Sheets("変換")
    Set Sh2 = Sheets("商品")
     
    For k = 2 To Sh2.Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
            If Sh1.Cells(i, 1) = Sh2.Cells(k, 1) Then
                Sh2.Cells(k, 1) = Sh1.Cells(i, 2)
                 
                If Sh1.Cells(i, 3) <> "" Then
                    l = Sh1.Cells(i, 3)
                    Sh2.Cells(k, 2) = l * Sh2.Cells(k, 2)
                End If
 
                Exit For
            End If
        Next i
    Next k
End Sub
 
の結果になります。
 
■商品シート
商品CD1　時間
い     10
あ     30
 
以上、お手数をお掛けしますがご教示よろしくお願い致します。

挿入処理を行う際は、k の繰り返しを下から上に順次実行してください。
そうすれば、挿入処理の影響を受けなくてすみます。
こういう場合の定石（定跡）です。

simple様
ご回答ありがとうございます。
誠に恐縮ではございますが、もう少し詳細にご教示を頂けたら幸いです。
よろしくお願い致します。

For k = Sh2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
とするということです。
"VBA 挿入処理 下から"とか検索するとヒットするのでは？
 
簡単な挿入処理のマクロ記録をとれば、コードはわかりますよね。
ご自分でトライしてみて下さい。

「商品」を元に考えるのではなく、「変換」を元に考えてはいかがでしょうか？
 
変換を、

商品CD1	商品CD2	割合	時間
A	あ		30
B	い	0.5	20
B	い	0.5	20

商品CD1	時間	並び
B	20	1
A	30	2

商品CD1	商品CD2	割合	時間	並び
A	あ		30	2
B	い	0.5	20	1
B	い	0.5	20	1

simple様
Suzu様
アドバイスありがとうございます。
 
Suzu様
Suzu様がおっしゃる通り関数も考えましたが、明細行が10000行を超えるので
VBAを利用したいのが本音です。
対応策をご教示して頂きありがとうございます。
まだまだ、勉強不足の部分があり、ネットからVBAで挿入処理の検索を行い
「Rows(行番号).Insert」を利用して、例で記載させて頂いた結果をどのように
求めてよいのか悩んでいる状態です。

PowerQueryを使用しても良いでしょう。
 
Office TANAKA
 
マージの種類
http://officetanaka.net/excel/function/GetAndTransform/13.htm
 
PowerQuery 側で、 時間 x 割合 の計算まで済ませる様にしても良いでしょう。
 
let
    ソース = Excel.Workbook(File.Contents("ファイルフルパス.xlsx"), null, true),
    テーブル1_Table = ソース{[Item="テーブル1",Kind="Table"]}[Data],
    変更された型 = Table.TransformColumnTypes(テーブル1_Table,{{"商品CD1", type text}, {"時間", Int64.Type}, {"並び", Int64.Type}}),
    マージされたクエリ数 = Table.NestedJoin(変更された型, {"商品CD1"}, テーブル2, {"商品CD1"}, "テーブル2", JoinKind.LeftOuter),
    #"展開された テーブル2" = Table.ExpandTableColumn(マージされたクエリ数, "テーブル2", {"商品CD2", "割合"}, {"テーブル2.商品CD2", "テーブル2.割合"}),
    追加されたカスタム = Table.AddColumn(#"展開された テーブル2", "カスタム", each if [テーブル2.割合] <> null then [時間]*[テーブル2.割合] else [時間]),
    削除された列 = Table.RemoveColumns(追加されたカスタム,{"商品CD1", "時間", "テーブル2.割合"}),
    #"名前が変更された列 " = Table.RenameColumns(削除された列,{{"カスタム", "時間"}, {"テーブル2.商品CD2", "商品CD"}})
in
    #"名前が変更された列 "

Suzu様
いろいろとご教示をして頂き感謝しています。
最初からできないという言葉を使うべきではないですが、「PowerQuery」に
ついては利用した事がなく、全く真っ白な状態です。
大変申し訳ございません。

誠に恐縮ではございますが、やはり、Suzu様がおっしゃる通りに「商品」を元に考える
のではなく、「変換」を元に考えてVBAを作成した方がよいでしょうか？
 
例として掲載させて頂いたコードを基にして、何とかsimple様よりご教示をして頂いた
挿入処理（Rows(行番号).Insert）で自分なりに色々とトライしていますが、知識が
薄い事もあり、望んだ結果が表示できない状況です。
 
方向性あるいは、何度もネットで検索を行っていますが、参考になるサイトをご存じ
ならご教示願いたいです。
よろしくお願い致します。

引用:
誠に恐縮ではございますが、やはり、Suzu様がおっしゃる通りに「商品」を元に考える
のではなく、「変換」を元に考えてVBAを作成した方がよいでしょうか？

引用:
■商品シート
商品CD1　　時間
B　　　　　20
A　　　　　30
  
　↓結果
  
■商品シート
商品CD1　　時間
い　　　　　10
い　　　　　10
あ　　　　　30

引用:
時間についても【変換シート】の割合に応じて明細分に分割します。
今回の場合、割合がそれぞれ"0.5"ですので、【商品シート】時間をそれぞれ
”10”と表示させます。

sk様お返事ありがとうございます。
商品CDの一覧があるのですが、ある商品CDは1構成ではなく実は2構成なるので、
変換表通じて商品CDを2構成にして、時間についても割合の値を見て算出を行い
転記をしたいのです。
ご質問の内容と異なる場は再度、ご返答をさせて頂きます。
よろしくお願い致します。

商品シートに有って、変換シートに無かったら、どうするんですか？
 
■商品シート
商品CD1　　時間
B　　　　　 20
A　　　　　 30
SIC　　　　100　←変換シートにSICはない

引用:
商品CDの一覧があるのですが、ある商品CDは1構成ではなく実は2構成なるので、
変換表通じて商品CDを2構成にして、時間についても割合の値を見て算出を行い
転記をしたいのです。

半平太様
sk様
お返事ありがとうございます。
変換シートにない商品CDにつきましては変換を行わないで一覧の商品CDを
そのまま表示させます。
割合の件はおっしゃる通り、不正な値が表示さそうなので後で考える必要性が
あると考えています。
まず、商品一覧の商品CDが変換シートに複数存在したら、行を挿入して追加
する手順のアドバイスを恐縮ですが頂けたら幸いです。
よろしくお願い致します。

 行の挿入は負荷がある処理なので、１万行もあると効率悪いと思いますが、
 一度やってみても損はないと思います。
 
 For の書き方は既に示しました。
 あとは、下のコメント部分をコードにすればよいと思いますが、
 どこに詰まっているのでしょうか。
 挿入して下にシフトさせるのはマクロ記録でわかりますよ。（k行はRows(k) と書けます）
 あとは、既にコードがあるので、行番号などを変更するだけかと思いますが。

        If Sh1.Cells(i, 3) <> "" Then
            l = Sh1.Cells(i, 3)
            Sh2.Cells(k, 2) = l * Sh2.Cells(k, 2)
            'k+1行目に一行挿入
            'そのA列にコードを書きこむ
            'B列に、時間×割合を書き込む
        End If 

行挿入はストレスが掛かると思うので、
以下、一括上書き方式です。(元には戻せません）
 

Sub henkan()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim i As Long
    Dim k As Long
    Dim tempKey As Long
    Dim dicT As Object
    Dim dicOut As Object
    Dim vSRC
    Dim spl, subSpl, bufTime
    
    Set Sh1 = Sheets("変換")
    Set Sh2 = Sheets("商品")
    Set dicT = CreateObject("Scripting.Dictionary")
    Set dicOut = CreateObject("Scripting.Dictionary")
    
    '変換用を作成
    For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        dicT(Sh1.Cells(i, "A").Value) = dicT(Sh1.Cells(i, "A").Value) & "#!#" & _
        Sh1.Cells(i, "B") & "♪" & Sh1.Cells(i, "C")
    Next i

    '商品データ格納
    vSRC = Sh2.Range("A1", Sh2.Cells(Rows.Count, 1).End(xlUp)).Resize(, 2).Value
    
    '変換実行
    tempKey = 2
    For i = 2 To UBound(vSRC)
        
        If dicT(vSRC(i, 1)) = Empty Then
            dicOut(tempKey) = Array(vSRC(i, 1), vSRC(i, 2)) 'そのまま出力
            tempKey = tempKey + 1
        Else
            bufTime = vSRC(i, 2)
            spl = Split(dicT(vSRC(i, 1)), "#!#") '同種コードを分解
            
            For k = 1 To UBound(spl)
                subSpl = Split(spl(k), "♪")
                dicOut(tempKey) = Array(subSpl(0), IIf(IsNumeric(subSpl(1)), _
                        bufTime * Val(subSpl(1)), bufTime))
                tempKey = tempKey + 1
            Next k
        End If
    Next i
    
    '出力
    Sh2.Range("A2:B2").Resize(dicOut.Count) = Application.Index(dicOut.items, 0)
End Sub

simple様
お返事ありがとうございます。
朝からご迷惑をお掛けしています。
simple様からご教示を頂いた通りに記載を行いました。
 
If Sh1.Cells(i, 3) <> "" Then
   l = Sh1.Cells(i, 3)
   Sh2.Cells(k, 2) = l * Sh2.Cells(k, 2)
   Rows(k + 1).Insert
   Sh2.Cells(k + 1, 1) = Sh1.Cells(i, 2)
   Sh2.Cells(k + 1, 2) = l * Sh2.Cells(k, 2)
End If
 
結果は以下の通りになりました。
 
■商品シート
商品CD1　時間
い　　　 10
い　　　 5
あ　　　 30
 
また、変換シートを以下の様に変更してみました。
 
商品CD1　　商品CD2　割合
A　　　　　あ
B　　　　　い　　　　0.5
B　　　　　い　　　　0.3
B　　　　　い　　　　0.2
 
■商品シート（今回の結果）
商品CD1　時間
い　　　 10
い　　　 5
あ　　　 30
 
■商品シート（本来の結果）
商品CD1　時間
い　　　 10
い　　　　6
い　　　　4
あ　　　 30
 
一旦は、このコードで動作をさせたいのですが、やはり今のコードでは限界が
あるのでしょうか。
夜遅くに誠に恐縮です。
朝からお付き合いをして頂き大変申し訳ございません。
よろしくお願い致します。

(1)Rows(k+1)のワークシート指定がありません。
   たまたまSh1がアクティブだとそれに挿入を行います。
(2)不均等分割は想定していて、時間×割合とあえて書きましたが、
   その部分のコードが間違っていますね。
   ・Sh2.Cells(k + 1, 2) = l * Sh2.Cells(k, 2) は、
     0.7と0.3の分割でも、両方0.7を使ってしまいますから、間違いですw。
   ・また、その時点でSh2.Cells(k, 2)は既に割合が掛かったものですから、
     割合を掛ける相手として間違っています。
 
# ３つ以上に変換するケースも、変換表の商品が同じ間、挿入を繰り返せば勿論できますが、
# 他のかたからの回答コメントをお薦めします。
# ひとまず私はここでROMに回ります。

半平太様
大変遅くなりましたが、昨晩は遅くまでお付き合いをして頂きありがとう
ございました。
今回、アドバイスをして頂きましたが、これをベースに実際に作成を行う
予定のツールに応用させてみます。
それを実現する為に、1コード毎に解析をさせて頂きます。
 
simple様
朝早くにご回答ありがとうございました。
アドバイスを何回も頂き、ROMに回って頂くのに誠に恐縮ではございますが、
simple様からのアドバイスを頂いた手順についても実現可能なのか試して
みたいのです。
下記の件は承知致しました。
 
・Sh2.Cells(k + 1, 2) = l * Sh2.Cells(k, 2) は、
  0.7と0.3の分割でも、両方0.7を使ってしまいますから、間違いですw。
・また、その時点でSh2.Cells(k, 2)は既に割合が掛かったものですから、
  割合を掛ける相手として間違っています。
 
この情報を基に今朝から自分なりにいろいろとコードを変更して試して
みましたが、うまくできない状態です。（申し訳ございません）
どのように記述すればよいのかヒントあるいは、アドバイスを頂けない
でしょうか。
これで、最後にさせて頂きますので、よろしくお願い致します。

引用:
■商品シート
商品CD1　時間
い　　　 10
い　　　 5
あ　　　 30
  
また、変換シートを以下の様に変更してみました。
  
商品CD1　　商品CD2　割合
A　　　　　あ
B　　　　　い　　　　0.5
B　　　　　い　　　　0.3
B　　　　　い　　　　0.2

引用:
「商品」を元に考えるのではなく、「変換」を元に考えてVBAを作成した方がよいでしょうか？

引用:
変換シートにない商品CDにつきましては変換を行わないで
一覧の商品CDをそのまま表示させます。

Suzu様
sk様
大変遅くなりましたがお返事ありがとうございました。
アドバイスを頂いた内容をきちんと確認して、目的に向かって応用を
させて頂きます。
 
また、多くの皆様方にお忙しいところアドバイスを頂き感謝しています。
ありがとうございました。

解決済みにさせて頂きます。