マクロで統合

以前、https://oshiete.goo.ne.jp/qa/11091473.html　で質問したのですが、F列H列I列に追加でJ列とK列の項目も統合範囲に入れたいのですが、どこをどの様にマクロを書き足せば良いですか？
又、Sheet2のE列にSheet1のJ列、Sheet2のF列にSheet1のK列の統合結果も追加したいです。

宜しくお願いします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/05/27 20:38

こんばんは！

前回回答した者です。

今回の質問はSheet1の　F・H・I・J・K列　の5条件が一致したものの合計をSheet2に表示したい！
というコトですよね。

前回のコードに少し手を加えてみました。

Sub Sample2()
　Dim myDic As Object
　Dim i As Long, lastRow As Long
　Dim myStr As String, wS As Worksheet
　Dim myKey, myItem, myR, myAry

　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　If lastRow > 1 Then
　　　　　Range(wS.Cells(2, "A"), wS.Cells(lastRow, "F")).ClearContents '//★//
　　　　End If
　　　　With Worksheets("Sheet1")
　　　　　lastRow = .Cells(Rows.Count, "F").End(xlUp).Row
　　　　　　myR = Range(.Cells(2, "F"), .Cells(lastRow, "L"))
　　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　　myStr = myR(i, 1) & "_" & myR(i, 3) & "_" & myR(i, 4) & "_" & myR(i, 5) & "_" & myR(i, 6) '//★//
　　　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　　　myDic.Add myStr, myR(i, 7)
　　　　　　　　　Else
　　　　　　　　　　myDic(myStr) = myDic(myStr) + myR(i, 7)
　　　　　　　　　End If
　　　　　　　Next i
　　　　　　myKey = myDic.keys
　　　　　　myItem = myDic.items
　　　　　　　myR = Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "F"))
　　　　　　　　For i = 0 To UBound(myKey)
　　　　　　　　　myAry = Split(myKey(i), "_")
　　　　　　　　　　myR(i + 1, 1) = myAry(0)
　　　　　　　　　　myR(i + 1, 2) = myAry(1)
　　　　　　　　　　myR(i + 1, 3) = myAry(2)
　　　　　　　　　　myR(i + 1, 4) = myItem(i)
　　　　　　　　　　myR(i + 1, 5) = myAry(3) '//★//
　　　　　　　　　　myR(i + 1, 6) = myAry(4) '//★//
　　　　　　　　Next i
　　　　　　　Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "F")) = myR '//★//
　　　　　　　　Set myDic = Nothing
　　　　　　　　wS.Activate
　　　　　　　　MsgBox "完了"
　　　　End With
End Sub

※　「★」の行が前回と変わっているところです。
尚、列数が多いと列方向にループしても良いのですが、
前回のコードをそのまま使った方が判りやすいと思い、ループはしていません。

Sheet1のすべての列が対象ではない（G列だけが飛んでいる）のと、
表示する列順がSheet1の列順と異なるためループするために変数を追加する必要がありそうです。

そうなると判りにくくなると思い、一つ一つ値を入れています。m(_ _)m

この回答へのお礼

今回も思うように出来ました！
前回に続き今回も本当にありがとうございました！

お礼日時：2019/05/28 14:23