Option Explicit
 
Public Sub 同じ行にまとめ()
    Dim wb1 As Workbook     'Book1
    Dim wb2 As Workbook     'Book2
    Dim ws1 As Worksheet    '売上明細
    Dim ws2 As Worksheet    '進捗状況
    Dim ws3 As Worksheet    'Sheet1
    Dim dicT1 As Object     'キー：売上月＋部門＋チーム＋商品コード＋商品名　値：Sheet1の行番号
    Dim dicT2 As Object     'キー：売上月＋商品名　値：Sheet1の行番号
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim row3 As Long
    Dim maxrow3 As Long: maxrow3 = 2
    Dim key1 As String
    Dim key2 As String
    Dim kind As String
    Dim kinds As Variant: kinds = Array("確認中", "出荷準備中", "出荷済")
    Dim i As Long
    Dim col3 As Long
    Set dicT1 = CreateObject("Scripting.Dictionary")
    Set dicT2 = CreateObject("Scripting.Dictionary")
    Set ws3 = Worksheets("Sheet1")
    ws3.Rows("2:" & Rows.Count).ClearContents
 
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\" & "Book1.xlsx")
    Set ws1 = wb1.Worksheets("売上明細")
    Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & "Book2.xlsx")
    Set ws2 = wb2.Worksheets("進捗状況")
    maxrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row    '最大行取得
    maxrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row    '最大行取得
    '売上明細読込
    For row1 = 2 To maxrow1
        key1 = ws1.Cells(row1, 1).Value & "|" & ws1.Cells(row1, 2).Value & "|" & ws1.Cells(row1, 3).Value & "|" & ws1.Cells(row1, 4).Value & "|" & ws1.Cells(row1, 5).Value
        key2 = ws1.Cells(row1, 1).Value & "|" & ws1.Cells(row1, 5).Value
        If dicT1.exists(key1) = False Then
            dicT1(key1) = maxrow3
            '売上月～商品名
            ws3.Cells(maxrow3, 1).Resize(1, 5).Value = ws1.Cells(row1, 1).Resize(1, 5).Value
            '合計金額
            ws3.Cells(maxrow3, 6).Value = ws1.Cells(row1, 6).Value
            '進捗状態
            ws3.Cells(maxrow3, 7).Value = 0
            ws3.Cells(maxrow3, 8).Value = 0
            ws3.Cells(maxrow3, 9).Value = 0
            If dicT2.exists(key2) = False Then
                dicT2(key2) = maxrow3
            Else
                MsgBox ("売上月＋商品名で不正な重複発生")
                ws1.Activate
                ws1.Cells(row1, 1).Select
                Exit Sub
            End If
            maxrow3 = maxrow3 + 1
        Else
            '合計金額加算
            row3 = dicT1(key1)
            ws3.Cells(row3, 6).Value = ws3.Cells(row3, 6).Value + ws1.Cells(row1, 6).Value
        End If
    Next
    '進捗状況読込
    For row2 = 2 To maxrow2
        key2 = ws2.Cells(row2, 2).Value & "|" & ws2.Cells(row2, 3).Value
        If dicT2.exists(key2) = False Then
            MsgBox ("売上月＋商品名が売上明細になし")
            ws2.Activate
            ws2.Cells(row2, 2).Select
            Exit Sub
        End If
        kind = ws2.Cells(row2, 1).Value
        i = get_index(kind, kinds)
        If i = -1 Then
            MsgBox ("進捗状況が不正")
            ws2.Activate
            ws2.Cells(row2, 1).Select
            Exit Sub
        End If
        '進捗状態加算
        row3 = dicT2(key2)
        col3 = 7 + i
        ws3.Cells(row3, col3).Value = ws3.Cells(row3, col3).Value + 1
    Next
    wb1.Close
    wb2.Close
    MsgBox ("完了")
End Sub
Private Function get_index(ByVal kind As String, ByVal kinds As Variant) As Long
    Dim i As Long
    For i = 0 To UBound(kinds)
        If kind = kinds(i) Then
            get_index = i
            Exit Function
        End If
    Next
    get_index = -1
End Function
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOWQjOOBmOihjOOBq+OBvuOBqOOCgSgpCiAgICBEaW0gd2IxIEFzIFdvcmtib29rICAgICAnQm9vazEKICAgIERpbSB3YjIgQXMgV29ya2Jvb2sgICAgICdCb29rMgogICAgRGltIHdzMSBBcyBXb3Jrc2hlZXQgICAgJ+WjsuS4iuaYjue0sAogICAgRGltIHdzMiBBcyBXb3Jrc2hlZXQgICAgJ+mAsuaNl+eKtuazgQogICAgRGltIHdzMyBBcyBXb3Jrc2hlZXQgICAgJ1NoZWV0MQogICAgRGltIGRpY1QxIEFzIE9iamVjdCAgICAgJ+OCreODvO+8muWjsuS4iuaciO+8i+mDqOmWgO+8i+ODgeODvOODoO+8i+WVhuWTgeOCs+ODvOODie+8i+WVhuWTgeWQjeOAgOWApO+8mlNoZWV0MeOBruihjOeVquWPtwogICAgRGltIGRpY1QyIEFzIE9iamVjdCAgICAgJ+OCreODvO+8muWjsuS4iuaciO+8i+WVhuWTgeWQjeOAgOWApO+8mlNoZWV0MeOBruihjOeVquWPtwogICAgRGltIG1heHJvdzEgQXMgTG9uZwogICAgRGltIG1heHJvdzIgQXMgTG9uZwogICAgRGltIHJvdzEgQXMgTG9uZwogICAgRGltIHJvdzIgQXMgTG9uZwogICAgRGltIHJvdzMgQXMgTG9uZwogICAgRGltIG1heHJvdzMgQXMgTG9uZzogbWF4cm93MyA9IDIKICAgIERpbSBrZXkxIEFzIFN0cmluZwogICAgRGltIGtleTIgQXMgU3RyaW5nCiAgICBEaW0ga2luZCBBcyBTdHJpbmcKICAgIERpbSBraW5kcyBBcyBWYXJpYW50OiBraW5kcyA9IEFycmF5KCLnorroqo3kuK0iLCAi5Ye66I235rqW5YKZ5LitIiwgIuWHuuiNt+a4iCIpCiAgICBEaW0gaSBBcyBMb25nCiAgICBEaW0gY29sMyBBcyBMb25nCiAgICBTZXQgZGljVDEgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikKICAgIFNldCBkaWNUMiA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkRpY3Rpb25hcnkiKQogICAgU2V0IHdzMyA9IFdvcmtzaGVldHMoIlNoZWV0MSIpCiAgICB3czMuUm93cygiMjoiICYgUm93cy5Db3VudCkuQ2xlYXJDb250ZW50cwogICAgCiAgICBTZXQgd2IxID0gV29ya2Jvb2tzLk9wZW4oVGhpc1dvcmtib29rLlBhdGggJiAiXCIgJiAiQm9vazEueGxzeCIpCiAgICBTZXQgd3MxID0gd2IxLldvcmtzaGVldHMoIuWjsuS4iuaYjue0sCIpCiAgICBTZXQgd2IyID0gV29ya2Jvb2tzLk9wZW4oVGhpc1dvcmtib29rLlBhdGggJiAiXCIgJiAiQm9vazIueGxzeCIpCiAgICBTZXQgd3MyID0gd2IyLldvcmtzaGVldHMoIumAsuaNl+eKtuazgSIpCiAgICBtYXhyb3cxID0gd3MxLkNlbGxzKFJvd3MuQ291bnQsIDEpLkVuZCh4bFVwKS5Sb3cgICAgJ+acgOWkp+ihjOWPluW+lwogICAgbWF4cm93MiA9IHdzMi5DZWxscyhSb3dzLkNvdW50LCAxKS5FbmQoeGxVcCkuUm93ICAgICfmnIDlpKfooYzlj5blvpcKICAgICflo7LkuIrmmI7ntLDoqq3ovrwKICAgIEZvciByb3cxID0gMiBUbyBtYXhyb3cxCiAgICAgICAga2V5MSA9IHdzMS5DZWxscyhyb3cxLCAxKS5WYWx1ZSAmICJ8IiAmIHdzMS5DZWxscyhyb3cxLCAyKS5WYWx1ZSAmICJ8IiAmIHdzMS5DZWxscyhyb3cxLCAzKS5WYWx1ZSAmICJ8IiAmIHdzMS5DZWxscyhyb3cxLCA0KS5WYWx1ZSAmICJ8IiAmIHdzMS5DZWxscyhyb3cxLCA1KS5WYWx1ZQogICAgICAgIGtleTIgPSB3czEuQ2VsbHMocm93MSwgMSkuVmFsdWUgJiAifCIgJiB3czEuQ2VsbHMocm93MSwgNSkuVmFsdWUKICAgICAgICBJZiBkaWNUMS5leGlzdHMoa2V5MSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgIGRpY1QxKGtleTEpID0gbWF4cm93MwogICAgICAgICAgICAn5aOy5LiK5pyI772e5ZWG5ZOB5ZCNCiAgICAgICAgICAgIHdzMy5DZWxscyhtYXhyb3czLCAxKS5SZXNpemUoMSwgNSkuVmFsdWUgPSB3czEuQ2VsbHMocm93MSwgMSkuUmVzaXplKDEsIDUpLlZhbHVlCiAgICAgICAgICAgICflkIjoqIjph5HpoY0KICAgICAgICAgICAgd3MzLkNlbGxzKG1heHJvdzMsIDYpLlZhbHVlID0gd3MxLkNlbGxzKHJvdzEsIDYpLlZhbHVlCiAgICAgICAgICAgICfpgLLmjZfnirbmhYsKICAgICAgICAgICAgd3MzLkNlbGxzKG1heHJvdzMsIDcpLlZhbHVlID0gMAogICAgICAgICAgICB3czMuQ2VsbHMobWF4cm93MywgOCkuVmFsdWUgPSAwCiAgICAgICAgICAgIHdzMy5DZWxscyhtYXhyb3czLCA5KS5WYWx1ZSA9IDAKICAgICAgICAgICAgSWYgZGljVDIuZXhpc3RzKGtleTIpID0gRmFsc2UgVGhlbgogICAgICAgICAgICAgICAgZGljVDIoa2V5MikgPSBtYXhyb3czCiAgICAgICAgICAgIEVsc2UKICAgICAgICAgICAgICAgIE1zZ0JveCAoIuWjsuS4iuaciO+8i+WVhuWTgeWQjeOBp+S4jeato+OBqumHjeikh+eZuueUnyIpCiAgICAgICAgICAgICAgICB3czEuQWN0aXZhdGUKICAgICAgICAgICAgICAgIHdzMS5DZWxscyhyb3cxLCAxKS5TZWxlY3QKICAgICAgICAgICAgICAgIEV4aXQgU3ViCiAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBtYXhyb3czID0gbWF4cm93MyArIDEKICAgICAgICBFbHNlCiAgICAgICAgICAgICflkIjoqIjph5HpoY3liqDnrpcKICAgICAgICAgICAgcm93MyA9IGRpY1QxKGtleTEpCiAgICAgICAgICAgIHdzMy5DZWxscyhyb3czLCA2KS5WYWx1ZSA9IHdzMy5DZWxscyhyb3czLCA2KS5WYWx1ZSArIHdzMS5DZWxscyhyb3cxLCA2KS5WYWx1ZQogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgJ+mAsuaNl+eKtuazgeiqrei+vAogICAgRm9yIHJvdzIgPSAyIFRvIG1heHJvdzIKICAgICAgICBrZXkyID0gd3MyLkNlbGxzKHJvdzIsIDIpLlZhbHVlICYgInwiICYgd3MyLkNlbGxzKHJvdzIsIDMpLlZhbHVlCiAgICAgICAgSWYgZGljVDIuZXhpc3RzKGtleTIpID0gRmFsc2UgVGhlbgogICAgICAgICAgICBNc2dCb3ggKCLlo7LkuIrmnIjvvIvllYblk4HlkI3jgYzlo7LkuIrmmI7ntLDjgavjgarjgZciKQogICAgICAgICAgICB3czIuQWN0aXZhdGUKICAgICAgICAgICAgd3MyLkNlbGxzKHJvdzIsIDIpLlNlbGVjdAogICAgICAgICAgICBFeGl0IFN1YgogICAgICAgIEVuZCBJZgogICAgICAgIGtpbmQgPSB3czIuQ2VsbHMocm93MiwgMSkuVmFsdWUKICAgICAgICBpID0gZ2V0X2luZGV4KGtpbmQsIGtpbmRzKQogICAgICAgIElmIGkgPSAtMSBUaGVuCiAgICAgICAgICAgIE1zZ0JveCAoIumAsuaNl+eKtuazgeOBjOS4jeatoyIpCiAgICAgICAgICAgIHdzMi5BY3RpdmF0ZQogICAgICAgICAgICB3czIuQ2VsbHMocm93MiwgMSkuU2VsZWN0CiAgICAgICAgICAgIEV4aXQgU3ViCiAgICAgICAgRW5kIElmCiAgICAgICAgJ+mAsuaNl+eKtuaFi+WKoOeulwogICAgICAgIHJvdzMgPSBkaWNUMihrZXkyKQogICAgICAgIGNvbDMgPSA3ICsgaQogICAgICAgIHdzMy5DZWxscyhyb3czLCBjb2wzKS5WYWx1ZSA9IHdzMy5DZWxscyhyb3czLCBjb2wzKS5WYWx1ZSArIDEKICAgIE5leHQKICAgIHdiMS5DbG9zZQogICAgd2IyLkNsb3NlCiAgICBNc2dCb3ggKCLlrozkuoYiKQpFbmQgU3ViClByaXZhdGUgRnVuY3Rpb24gZ2V0X2luZGV4KEJ5VmFsIGtpbmQgQXMgU3RyaW5nLCBCeVZhbCBraW5kcyBBcyBWYXJpYW50KSBBcyBMb25nCiAgICBEaW0gaSBBcyBMb25nCiAgICBGb3IgaSA9IDAgVG8gVUJvdW5kKGtpbmRzKQogICAgICAgIElmIGtpbmQgPSBraW5kcyhpKSBUaGVuCiAgICAgICAgICAgIGdldF9pbmRleCA9IGkKICAgICAgICAgICAgRXhpdCBGdW5jdGlvbgogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgZ2V0X2luZGV4ID0gLTEKRW5kIEZ1bmN0aW9uCg==