Excelで売り上げ件数から原材料の使用量を計算するやつ

Excelで売り上げ件数から原材料の使用量を計算するマクロがある程度完成したからメモ

' ------------------------------
' 商品使用数の集計
' 　※商品マスタのレイアウトが変わった場合、マクロも合わせて修正が必要
' 　　Ａ列：店舗コード
' 　　Ｂ列：店舗名称
' 　　Ｃ列：メニュー区分
' 　　Ｄ列：メニューコード
' 　　Ｅ列：メニュー名
' 　　Ｆ列：単価
' 　　Ｇ列：商品コード
' 　　Ｈ列：商品区分
' 　　Ｉ列：商品名
' 　　Ｊ列：数量1
' 　　Ｋ列：単位
' 　　Ｌ列：数量2
' 　　Ｍ列：開始日
' 　　Ｎ列：終了日
' 　　１行目はタイトル行、２行目からデータ
' ------------------------------
Sub subShiyosu()

    Dim shtMst          As Worksheet    ' シート：商品マスタ
    Dim shtCsv          As Worksheet    ' シート：CSVの取り込み先
    Dim shtWork         As Worksheet    ' シート：一時保存
    Dim shtReport       As Worksheet    ' シート：出力
    Dim strFilepass     As String       ' csvのファイルパス
    Dim i               As Long         ' ループカウンタ
    Dim lngRow          As Long         ' 最終行
    Dim varTemp         As Variant      ' 配列
    Dim pvc             As PivotCache   ' ピボットテーブル
    Dim pvt             As PivotTable

    On Error GoTo ErrTrap

    Set shtMst = ThisWorkbook.Worksheets("商品マスタ")
    Set shtCsv = ThisWorkbook.Worksheets("●CSV")
    Set shtWork = ThisWorkbook.Worksheets("●WORK")
    Set shtReport = ThisWorkbook.Worksheets("●出力")


    ' --------------------
    ' 開始処理
    ' --------------------

    ' 画面表示停止
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    ' マスタシートの数式再計算停止
    With shtMst
        .DisplayPageBreaks = False
        .EnableCalculation = False
    End With
    
    ' 処理用シートの初期化
    With shtCsv
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtWork
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtReport
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    
    ' --------------------
    ' 売上ファイルを取り込む（店・メニュー毎の売上件数CSV）
    ' --------------------

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*売上*.csv"
        .AllowMultiSelect = False
        If .Show = True Then
            strFilepass = .SelectedItems(1)
            Call subImportCSV(strFilepass, shtCsv, shtCsv.Cells(1, 1))
        Else
            Call MsgBox("処理を中止します")
            GoTo FIN
        End If
    End With
    
    
    ' --------------------
    ' 商品使用量を計算する
    ' --------------------

    ' 商品マスタと売上ファイルを突合する
    ' 　条件：店舗コード・メニューコードの一致、売上日が開始日〜終了日の範囲内
    ' 　処理：メニューで突合して、売上件数と商品使用量の積から使用量の総数を計算
    lngRow = shtMst.Cells(Rows.Count, 1).End(xlUp).row
    varTemp = shtMst.Range(shtMst.Cells(1, 1), shtMst.Cells(lngRow, 14))
    shtWork.Range(shtWork.Cells(1, 1), shtWork.Cells(lngRow, 14)) = varTemp
   
    shtWork.Cells(1, 15).Value = "使用量"
    
    lngRow = shtCsv.Cells(Rows.Count, 1).End(xlUp).row
    shtWork.Cells(2, 15).Formula = "=IFERROR(" & _
                                        "SUMIFS(" & _
                                            "●CSV!$F$2:$F$" & lngRow & _
                                            ",●CSV!$A$2:$A$" & lngRow & ",●WORK!A2" & _
                                            ",●CSV!$D$2:$D$" & lngRow & ",●WORK!D2" & _
                                            ",●CSV!$C$2:$C$" & lngRow & ","">=""&●WORK!M2" & _
                                            ",●CSV!$C$2:$C$" & lngRow & ",""<=""&●WORK!N2" & _
                                            ") * ●WORK!J2" & _
                                        ",0)"
    
    lngRow = shtWork.Cells(Rows.Count, 1).End(xlUp).row
    shtWork.Cells(2, 15).AutoFill Destination:=shtWork.Range(shtWork.Cells(2, 15), shtWork.Cells(lngRow, 15))
    
    ' 計算式を値に変換する
    varTemp = shtWork.Range(shtWork.Cells(2, 15), shtWork.Cells(lngRow, 15))
    shtWork.Range(shtWork.Cells(2, 15), shtWork.Cells(lngRow, 15)) = varTemp
    
    
    ' ピボットテーブルで店舗、商品ごとに合算する
    Set pvc = ThisWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase _
                , SourceData:=shtWork.Range(shtWork.Cells(1, 1), shtWork.Cells(lngRow, 15)) _
                , Version:=xlPivotTableVersion14)

    Set pvt = pvc.CreatePivotTable( _
                TableDestination:=shtWork.Cells(1, 27) _
                , TableName:="pvtSyukei_Shiyosu" _
                , DefaultVersion:=xlPivotTableVersion14)

    With pvt.PivotFields(shtWork.Cells(1, 1).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 1
    End With

    With pvt.PivotFields(shtWork.Cells(1, 2).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 2
    End With

    With pvt.PivotFields(shtWork.Cells(1, 8).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 3
    End With

    With pvt.PivotFields(shtWork.Cells(1, 7).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 4
    End With

    With pvt.PivotFields(shtWork.Cells(1, 9).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 5
    End With

    With pvt.PivotFields(shtWork.Cells(1, 11).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 6
    End With

    pvt.AddDataField pvt.PivotFields(shtWork.Cells(1, 15).Value), "合計 / 使用量", xlSum


    ' 集計結果を出力シートに転記
    lngRow = shtCsv.Cells(Rows.Count, 1).End(xlUp).row
    With shtReport
        .Cells(1, 1).Value = "商品使用量の集計"
        .Cells(2, 1).Formula = "=""抽出期間：""&TEXT(MIN(●CSV!C2:C" & lngRow & "),""yyyy/m/d"")&"" 〜 ""&TEXT(MAX(●CSV!C2:C" & lngRow & "),""yyyy/m/d"")"
        .Cells(2, 1).Value = shtReport.Cells(2, 1).Value
    End With
    
    lngRow = shtWork.Cells(Rows.Count, 27).End(xlUp).row
    varTemp = shtWork.Range(shtWork.Cells(1, 27), shtWork.Cells(lngRow, 33))
    shtReport.Range(shtReport.Cells(4, 2), shtReport.Cells(lngRow + 3, 8)).Value = varTemp

    ' Work初期化
    shtWork.Cells.Delete shift:=xlToLeft


    ' --------------------
    ' マスタ設定漏れをチェックする
    ' --------------------

    ' 商品マスタと売上ファイルを突合する
    ' 　条件：店舗コード・メニューコードの一致、売上日が開始日〜終了日の範囲内
    ' 　処理：メニュー名が不一致の場合、マスタ設定漏れを疑う
    shtCsv.Cells(1, 10).Value = "マスタチェック用"
    
    lngRow = shtMst.Cells(Rows.Count, 1).End(xlUp).row
    shtCsv.Cells(2, 10).Formula = "=IF(●CSV!E2 = " & _
                                    "OFFSET(商品マスタ!$A$1" & _
                                        ",SUMIFS(" & _
                                            "商品マスタ!$Q$2:$Q$" & lngRow & _
                                            ",商品マスタ!$A$2:$A$" & lngRow & ",●CSV!A2" & _
                                            ",商品マスタ!$D$2:$D$" & lngRow & ",●CSV!D2" & _
                                            ",商品マスタ!$M$2:$M$" & lngRow & ",""<=""&●CSV!C2" & _
                                            ",商品マスタ!$N$2:$N$" & lngRow & ","">=""&●CSV!C2" & _
                                            ") - 1" & _
                                        ",4)" & _
                                    ",TRUE,FALSE)"

    lngRow = shtCsv.Cells(Rows.Count, 1).End(xlUp).row
    shtCsv.Cells(2, 10).AutoFill Destination:=shtCsv.Range(shtCsv.Cells(2, 10), shtCsv.Cells(lngRow, 10))

    ' 計算式を値に変換する
    varTemp = shtCsv.Range(shtCsv.Cells(2, 10), shtCsv.Cells(lngRow, 10))
    shtCsv.Range(shtCsv.Cells(2, 10), shtCsv.Cells(lngRow, 10)) = varTemp


    ' 集計結果を出力シートに転記
    shtReport.Cells(1, 11).Value = "マスタ設定漏れと思われるもの"
    
    With shtCsv.Range(shtCsv.Cells(1, 1), shtCsv.Cells(lngRow, 10))
        .AutoFilter Field:=10, Criteria1:="<>TRUE"
        .Copy Destination:=shtReport.Cells(3, 11)
        .AutoFilter
    End With

    ' CSV初期化
    shtCsv.Cells.Delete shift:=xlToLeft


    ' --------------------
    ' 集計結果を新しいブックへコピー
    ' --------------------
    
    With shtReport
        .Visible = True
        .Copy
        .Visible = False
        .Cells.Delete shift:=xlToLeft
    End With

    GoTo FIN


ErrTrap:

    ' --------------------
    ' エラー処理
    ' --------------------

    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
    
    GoTo FIN

FIN:

    ' --------------------
    ' 終了処理
    ' --------------------

    ' マスタシートの数式再計算を戻す
    With shtMst
        .DisplayPageBreaks = True
        .EnableCalculation = True
    End With
    
    ' 処理用シートの印刷範囲の再計算を戻す
    With shtCsv
        .DisplayPageBreaks = True
    End With
    
    With shtWork
        .DisplayPageBreaks = True
    End With
    
    With shtReport
        .DisplayPageBreaks = True
    End With
       
    ' 画面表示を戻す
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

' ------------------------------
' 仕入数の集計
' ------------------------------
Sub subShiire()

    On Error GoTo ErrTrap


    ' --------------------
    ' 開始処理
    ' --------------------

    ' 画面表示停止
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    

    ' --------------------
    ' 売上システム分の集計
    ' --------------------
    Call subShiire_Uriage
    
    
    ' --------------------
    ' 弥生販売分の集計
    ' --------------------
    Call subShiire_Yayoi

    
    GoTo FIN


ErrTrap:

    ' --------------------
    ' エラー処理
    ' --------------------

    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
    
    GoTo FIN


FIN:

    ' --------------------
    ' 終了処理
    ' --------------------
       
    ' 画面表示を戻す
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub

' ------------------------------
' 仕入数の集計（売上システム分）
' ------------------------------
Sub subShiire_Uriage()

    Dim shtCsv              As Worksheet    ' シート：CSVの取り込み先
    Dim shtWork             As Worksheet    ' シート：一時保存
    Dim shtReport           As Worksheet    ' シート：出力
    Dim strFilepass         As String       ' csvのファイルパス
    Dim i                   As Long         ' ループカウンタ
    Dim lngRow              As Long         ' 最終行
    Dim varTemp             As Variant      ' 配列用
    Dim pvc                 As PivotCache   ' ピボットテーブル
    Dim pvt                 As PivotTable
    Dim strStoreCode        As String       ' 仕入情報の一時保管
    Dim strStoreName        As String
    Dim strClientCode       As String
    Dim strClientName       As String
    Dim strSiire            As String
    Dim strTradingDate      As String

    On Error GoTo ErrTrap_Uriage

    Set shtCsv = ThisWorkbook.Worksheets("●CSV")
    Set shtWork = ThisWorkbook.Worksheets("●WORK")
    Set shtReport = ThisWorkbook.Worksheets("●出力")


    ' --------------------
    ' 開始処理
    ' --------------------

    ' 処理用シートの初期化
    With shtCsv
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtWork
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtReport
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With


    ' --------------------
    ' 仕入を取り込む（店毎の仕入情報txt）
    ' --------------------

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*仕入*.txt"
        .AllowMultiSelect = False
        If .Show = True Then
            strFilepass = .SelectedItems(1)
            Call subImportCSV(strFilepass, shtCsv, shtCsv.Cells(1, 1))
        Else
            Call MsgBox("処理を中止します")
            GoTo FIN_Uriage
        End If
    End With
    
    
    ' --------------------
    ' 仕入データを整形する
    ' 　※１）カンマ区切りテキスト形式だが、数値の桁区切りカンマが使われている
    ' 　　　　とりあえず最終列の売上額だけが1000を超えているため対処しているが
    '         購入数など途中の列が1000を超えた場合はお手上げ
    ' 　※２）データ内の購入数と単価をかけても購入金額にはならない
    ' 　　　　売上システムで合計金額も手入力できるため打ち間違いが起こっているように見える
    ' 　　　　このマクロでは、比較的信頼できる購入数と単価をもとに計算しているため
    ' 　　　　<店舗計>や<総計>と異なる額になっている
    ' --------------------

    ' 配列内で処理
    lngRow = shtCsv.Cells(Rows.Count, 1).End(xlUp).row
    varTemp = shtCsv.Range(shtCsv.Cells(1, 1), shtCsv.Cells(lngRow, 11))

    For i = 1 To lngRow

        Select Case True
        
            Case varTemp(i, 1) = "【レポートファイル名:RDin400_2】"
            
                ' 処理なし
            
            Case varTemp(i, 1) = "◇◆◇ 仕入 ◇◆◇"
            
                ' 処理なし

            Case Left(varTemp(i, 1), 6) = "【範囲指定】"
            
                ' 処理なし

            Case varTemp(i, 1) = "< 店 舗 計 >"

                ' 処理なし

            Case varTemp(i, 1) = "< 仕入先計 >"

                ' 処理なし

            Case varTemp(i, 3) = "< 仕入先計 >"

                ' <仕入先計>がページ先頭の場合、A-B列に店舗が入るためC列を参照
                ' 処理なし

            Case varTemp(i, 1) = "<　総　計　>"
            
                ' 処理なし

            Case varTemp(i, 1) = "分類"
            
                ' 処理なし

            Case varTemp(i, 1) = "仕入先"
            
                ' 処理なし

            Case varTemp(i, 1) = "店舗:"
                
                ' 店舗またはページの切り替わり
                
                ' 店舗を保持
                strStoreCode = varTemp(i, 2)
                strStoreName = varTemp(i, 3)

            Case IsDate(varTemp(i, 4)) _
                    And varTemp(i + 1, 3) = "" _
                    And Right(varTemp(i + 2, 3), 1) = "締"

                ' ※※※ バグ対応 ※※※
                ' <仕入先計>が前ページの最終行の場合（？）
                ' 1行目のA-B列に誤った仕入先、2行目のA-B列に正しい仕入先、3行目に単位などが出力する

                ' 仕入先を保持（2行目から引っ張ってくる）
                strClientCode = varTemp(i + 1, 1)
                strClientName = varTemp(i + 1, 2)
                strSiire = varTemp(i, 3)
                strTradingDate = varTemp(i, 4)
                
                ' 正しい仕入先を入れる（バグ対応）
                varTemp(i, 1) = strClientCode
                varTemp(i, 2) = strClientName
                
                ' 売上金額をまとめる（桁区切りカンマ対応）
                If varTemp(i, 9) <> "" And IsNumeric(varTemp(i, 9)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3) & _
                                        Right("000" & varTemp(i, 9), 3)
                ElseIf varTemp(i, 8) <> "" And IsNumeric(varTemp(i, 8)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3)
                End If
                
                ' 店舗、単位（空欄の場合もある）を挿入
                varTemp(i, 8) = strStoreCode
                varTemp(i, 9) = strStoreName
                varTemp(i, 10) = varTemp(i + 2, 6)
                varTemp(i, 11) = "●"
                
                ' 2つ後の行から単位を回収したのでスキップ
                i = i + 2

            Case IsDate(varTemp(i, 2)) _
                    And Right(varTemp(i + 1, 3), 1) = "締"

                ' ※※※ バグ対応 ※※※
                ' 同じ日に、同じ店舗で、同じ商品を2回以上仕入れた場合（？）
                ' それ以降、その商品のA-B列の仕入れ先が省略されてしまう

                ' 店舗を挿入（右シフト）
                varTemp(i, 11) = varTemp(i, 9)
                varTemp(i, 10) = varTemp(i, 8)
                varTemp(i, 9) = varTemp(i, 7)
                varTemp(i, 8) = varTemp(i, 6)
                varTemp(i, 7) = varTemp(i, 5)
                varTemp(i, 6) = varTemp(i, 4)
                varTemp(i, 5) = varTemp(i, 3)
                varTemp(i, 4) = varTemp(i, 2)
                varTemp(i, 3) = varTemp(i, 1)
                varTemp(i, 2) = strClientName
                varTemp(i, 1) = strClientCode

                ' 仕入先を保持
                strTradingDate = varTemp(i, 4)
                
                ' 売上金額をまとめる（桁区切りカンマ対応）
                If varTemp(i, 9) <> "" And IsNumeric(varTemp(i, 9)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3) & _
                                        Right("000" & varTemp(i, 9), 3)
                ElseIf varTemp(i, 8) <> "" And IsNumeric(varTemp(i, 8)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3)
                End If
                
                ' 店舗、単位（空欄の場合もある）を挿入
                varTemp(i, 8) = strStoreCode
                varTemp(i, 9) = strStoreName
                varTemp(i, 10) = varTemp(i + 1, 4)
                varTemp(i, 11) = "●"
                
                ' 次の行から単位を回収したのでスキップ
                i = i + 1

            Case IsDate(varTemp(i, 4)) _
                    And Right(varTemp(i + 1, 3), 1) = "締"

                ' 店舗−仕入先の1件目の取引
                ' 1行目のA-C列に取引先、D列に取引日、2行目のA列に「yyyy/m/d締」が入る

                ' 仕入先を保持
                strClientCode = varTemp(i, 1)
                strClientName = varTemp(i, 2)
                strSiire = varTemp(i, 3)
                strTradingDate = varTemp(i, 4)
                
                ' 売上金額をまとめる（桁区切りカンマ対応）
                If varTemp(i, 9) <> "" And IsNumeric(varTemp(i, 9)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3) & _
                                        Right("000" & varTemp(i, 9), 3)
                ElseIf varTemp(i, 8) <> "" And IsNumeric(varTemp(i, 8)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3)
                End If
                
                ' 店舗、単位（空欄の場合もある）を挿入
                varTemp(i, 8) = strStoreCode
                varTemp(i, 9) = strStoreName
                varTemp(i, 10) = varTemp(i + 1, 4)
                varTemp(i, 11) = "●"
                
                ' 次の行から単位を回収したのでスキップ
                i = i + 1

            Case IsDate(varTemp(i, 1)) _
                    And Right(varTemp(i + 1, 1), 1) = "締"
            
                ' 店舗−仕入先の2件目以降の取引で、その取引日の1件目の商品
                ' 1行目のA列に取引日、2行目のA列に「yyyy/m/d締」が入る
                
                ' 仕入先を挿入（右シフト）
                varTemp(i, 11) = varTemp(i, 8)
                varTemp(i, 10) = varTemp(i, 7)
                varTemp(i, 9) = varTemp(i, 6)
                varTemp(i, 8) = varTemp(i, 5)
                varTemp(i, 7) = varTemp(i, 4)
                varTemp(i, 6) = varTemp(i, 3)
                varTemp(i, 5) = varTemp(i, 2)
                varTemp(i, 4) = varTemp(i, 1)
                varTemp(i, 3) = strSiire
                varTemp(i, 2) = strClientName
                varTemp(i, 1) = strClientCode

                ' 取引日を保持
                strTradingDate = varTemp(i, 4)

                ' 売上金額をまとめる（桁区切りカンマ対応）
                If varTemp(i, 9) <> "" And IsNumeric(varTemp(i, 9)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3) & _
                                        Right("000" & varTemp(i, 9), 3)
                ElseIf varTemp(i, 8) <> "" And IsNumeric(varTemp(i, 8)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3)
                End If

                ' 店舗、単位（空欄の場合もある）を挿入
                varTemp(i, 8) = strStoreCode
                varTemp(i, 9) = strStoreName
                varTemp(i, 10) = varTemp(i + 1, 4)
                varTemp(i, 11) = "●"
                
                ' 次の行から単位を回収したのでスキップ
                i = i + 1

            Case Else
            
                ' 店舗−仕入先の2件目以降の取引で、その取引日の2件目以降の商品
                ' 1行目のA列が商品名、次の行のB列へ「対象」や「非対称」などが入る
                
                ' 仕入先を挿入（右シフト）
                varTemp(i, 11) = varTemp(i, 7)
                varTemp(i, 10) = varTemp(i, 6)
                varTemp(i, 9) = varTemp(i, 5)
                varTemp(i, 8) = varTemp(i, 4)
                varTemp(i, 7) = varTemp(i, 3)
                varTemp(i, 6) = varTemp(i, 2)
                varTemp(i, 5) = varTemp(i, 1)
                varTemp(i, 4) = strTradingDate
                varTemp(i, 3) = strSiire
                varTemp(i, 2) = strClientName
                varTemp(i, 1) = strClientCode
                
                ' 売上金額をまとめる（桁区切りカンマ対応）
                If varTemp(i, 9) <> "" And IsNumeric(varTemp(i, 9)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3) & _
                                        Right("000" & varTemp(i, 9), 3)
                ElseIf varTemp(i, 8) <> "" And IsNumeric(varTemp(i, 8)) = True Then
                    varTemp(i, 7) = varTemp(i, 7) & _
                                        Right("000" & varTemp(i, 8), 3)
                End If
                
                ' 店舗、単位（空欄の場合もある）を挿入
                varTemp(i, 8) = strStoreCode
                varTemp(i, 9) = strStoreName
                varTemp(i, 10) = varTemp(i + 1, 3)
                varTemp(i, 11) = "●"
            
                ' 次の行から単位を回収したのでスキップ
                i = i + 1
        
        End Select
            
    Next i

    ' タイトル行
    varTemp(1, 1) = "取引先コード"
    varTemp(1, 2) = "取引先名"
    varTemp(1, 3) = "仕入"
    varTemp(1, 4) = "取引日"
    varTemp(1, 5) = "商品名"
    varTemp(1, 6) = "仕入数"
    varTemp(1, 7) = "単価"
    varTemp(1, 8) = "店舗コード"
    varTemp(1, 9) = "店舗名"
    varTemp(1, 10) = "単位"
    varTemp(1, 11) = "集計用"

    ' 書式を初期化してから展開する
    shtCsv.Cells.Delete shift:=xlToLeft
    shtCsv.Range(shtCsv.Cells(1, 1), shtCsv.Cells(lngRow, 11)) = varTemp


    ' 仕入情報だけを抽出（＝K列に"●"が入っている行）
    With shtCsv.Range(shtCsv.Cells(1, 1), shtCsv.Cells(lngRow, 11))
        .AutoFilter Field:=11, Criteria1:="=●"
        .Copy Destination:=shtWork.Cells(1, 1)
        .AutoFilter
    End With
    
    ' CSV初期化
    shtCsv.Cells.Delete shift:=xlToLeft


    ' ピボットテーブルで店舗、商品ごとに合算する
    ' 　※単位は入力内容が統一されていないため集計条件から除外する
    lngRow = shtWork.Cells(Rows.Count, 1).End(xlUp).row
    Set pvc = ThisWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase _
                , SourceData:=shtWork.Range(shtWork.Cells(1, 1), shtWork.Cells(lngRow, 11)) _
                , Version:=xlPivotTableVersion14)

    Set pvt = pvc.CreatePivotTable( _
                TableDestination:=shtWork.Cells(1, 15) _
                , TableName:="pvtSyukei_Uriage" _
                , DefaultVersion:=xlPivotTableVersion14)

    With pvt.PivotFields(shtWork.Cells(1, 8).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 1
    End With

    With pvt.PivotFields(shtWork.Cells(1, 9).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 2
    End With

    With pvt.PivotFields(shtWork.Cells(1, 5).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 3
    End With

    pvt.AddDataField pvt.PivotFields(shtWork.Cells(1, 7).Value), "平均 / 単価", xlAverage

    pvt.AddDataField pvt.PivotFields(shtWork.Cells(1, 6).Value), "合計 / 仕入数", xlSum
    
    
    ' 集計結果を出力シートに転記
    With shtReport
        .Cells(1, 1).Value = "仕入数の集計（仕入から）"
        .Cells(2, 1).Formula = "=""抽出期間：""&TEXT(MIN(●WORK!D2:D" & lngRow & "),""yyyy/m/d"")&"" 〜 ""&TEXT(MAX(●WORK!D2:D" & lngRow & "),""yyyy/m/d"")"
        .Cells(2, 1).Value = shtReport.Cells(2, 1).Value
    End With
        
    varTemp = shtWork.Range(shtWork.Cells(1, 15), shtWork.Cells(lngRow, 19))
    shtReport.Range(shtReport.Cells(4, 2), shtReport.Cells(lngRow + 3, 6)).Value = varTemp

    ' Work初期化
    shtWork.Cells.Delete shift:=xlToLeft
    
    
    ' --------------------
    ' 集計結果を新しいブックへコピー
    ' --------------------
    
    ' 弥生の取り込み後にコピーする
    
    GoTo FIN_Uriage


ErrTrap_Uriage:

    ' --------------------
    ' エラー処理
    ' --------------------

    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
    
    GoTo FIN_Uriage


FIN_Uriage:

    ' --------------------
    ' 終了処理
    ' --------------------
   
    ' 処理用シートの印刷範囲の再計算を戻す
    With shtCsv
        .DisplayPageBreaks = True
    End With
    
    With shtWork
        .DisplayPageBreaks = True
    End With
    
    With shtReport
        .DisplayPageBreaks = True
    End With
    
End Sub

' ------------------------------
' 仕入数の集計（弥生販売分）
' ------------------------------
Sub subShiire_Yayoi()

    Dim shtCsv_1            As Worksheet                ' シート：CSVの取り込み先1
    Dim shtCsv_2            As Worksheet                ' シート：CSVの取り込み先2
    Dim shtWork             As Worksheet                ' シート：一時保存
    Dim shtReport           As Worksheet                ' シート：出力
    Dim strFilepass         As String                   ' csvのファイルパス
    Dim lngRow              As Long                     ' 最終行
    Dim varTemp             As Variant                  ' 配列用
    Dim pvc                 As PivotCache               ' ピボットテーブル
    Dim pvt                 As PivotTable
    Dim myExcel             As New Excel.Application    ' 取り込むExcelシート
    Dim myBook              As Workbook
    Dim mySheet             As Worksheet

'    On Error GoTo ErrTrap_Yayoi
    
    Set shtCsv_1 = ThisWorkbook.Worksheets("●CSV1")
    Set shtCsv_2 = ThisWorkbook.Worksheets("●CSV2")
    Set shtWork = ThisWorkbook.Worksheets("●WORK")
    Set shtReport = ThisWorkbook.Worksheets("●出力")


    ' --------------------
    ' 開始処理
    ' --------------------

    ' 処理用シートの初期化
    With shtCsv_1
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtCsv_2
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtWork
        .DisplayPageBreaks = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    With shtReport
        .DisplayPageBreaks = False
        ' 売上の取り込み結果が入っているため削除しない
        '.Cells.Delete shift:=xlToLeft
    End With


    ' --------------------
    ' 売上明細表を取り込む（店毎の仕入情報Excel）
    ' 　※弥生販売からExcel出力したもの、シート名が「sheet1」の前提
    ' 　※2アカウント分をそれぞれ取り込む（どちらから取り込んでもOK）
    ' --------------------

    ' 1回目の取り込み
    strFilepass = Application.GetOpenFilename()

    If strFilepass = "False" Then
        Call MsgBox("処理を中止します")
        GoTo FIN_Yayoi
    End If

    Set myBook = myExcel.Workbooks.Open(strFilepass)
    Set mySheet = myBook.Sheets("Sheet1")

    lngRow = mySheet.Cells(Rows.Count, 2).End(xlUp).row
    varTemp = mySheet.Range(mySheet.Cells(1, 1), mySheet.Cells(lngRow, 33))
    shtCsv_1.Range(shtCsv_1.Cells(1, 1), shtCsv_1.Cells(lngRow, 33)) = varTemp

    myBook.Close Savechanges:=False


    ' 2回目の取り込み
    strFilepass = Application.GetOpenFilename()

    If strFilepass = "False" Then
        Call MsgBox("処理を中止します")
        GoTo FIN_Yayoi
    End If

    Set myBook = myExcel.Workbooks.Open(strFilepass)
    Set mySheet = myBook.Sheets("Sheet1")

    lngRow = mySheet.Cells(Rows.Count, 2).End(xlUp).row
    varTemp = mySheet.Range(mySheet.Cells(1, 1), mySheet.Cells(lngRow, 33))
    shtCsv_2.Range(shtCsv_2.Cells(1, 1), shtCsv_2.Cells(lngRow, 33)) = varTemp

    myBook.Close Savechanges:=False



    ' --------------------
    ' 仕入データを整形する
    ' --------------------

    ' 1回目のシートに2回目の取り込んだデータを挿入する
    With shtCsv_1
        .Rows(4).Insert shift:=xlDown
        .Cells(4, 1).Value = shtCsv_2.Cells(3, 1).Value
    End With

    lngRow = shtCsv_2.Cells(Rows.Count, 2).End(xlUp).row
    varTemp = shtCsv_2.Range(shtCsv_2.Cells(7, 2), shtCsv_2.Cells(lngRow, 33))
    shtCsv_1.Range(shtCsv_1.Cells(shtCsv_1.Cells(Rows.Count, 2).End(xlUp).row + 1, 2), shtCsv_1.Cells(shtCsv_1.Cells(Rows.Count, 2).End(xlUp).row + lngRow + 1, 33)) = varTemp


    ' 仕入情報だけを抽出（＝F列が空欄でない行）
    lngRow = shtCsv_1.Cells(Rows.Count, 2).End(xlUp).row
    With shtCsv_1.Range(shtCsv_1.Cells(6, 2), shtCsv_1.Cells(lngRow, 33))
        .AutoFilter Field:=14, Criteria1:="<>"
        .Copy Destination:=shtWork.Cells(1, 1)
        .AutoFilter
    End With
    

    ' ピボットテーブルで店舗、商品ごとに合算する
    lngRow = shtWork.Cells(Rows.Count, 1).End(xlUp).row
    Set pvc = ThisWorkbook.PivotCaches.Create( _
                SourceType:=xlDatabase _
                , SourceData:=shtWork.Range(shtWork.Cells(1, 1), shtWork.Cells(lngRow, 32)) _
                , Version:=xlPivotTableVersion14)

    Set pvt = pvc.CreatePivotTable( _
                TableDestination:=shtWork.Cells(1, 40) _
                , TableName:="pvtSyukei_Yayoi" _
                , DefaultVersion:=xlPivotTableVersion14)

    With pvt.PivotFields(shtWork.Cells(1, 1).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 1
    End With

    With pvt.PivotFields(shtWork.Cells(1, 2).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 2
    End With

    With pvt.PivotFields(shtWork.Cells(1, 14).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 3
    End With

    With pvt.PivotFields(shtWork.Cells(1, 15).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 4
    End With
    
    With pvt.PivotFields(shtWork.Cells(1, 16).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 5
    End With

    With pvt.PivotFields(shtWork.Cells(1, 17).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 6
    End With

    With pvt.PivotFields(shtWork.Cells(1, 23).Value)
        .Orientation = xlRowField
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Position = 7
    End With

    pvt.AddDataField pvt.PivotFields(shtWork.Cells(1, 21).Value), "合計 / 数量", xlSum
    

    ' 集計結果を出力シートに転記
    With shtReport
        .Cells(1, 9).Value = "仕入数の集計（弥生の売上明細表）"
        .Cells(2, 9).Value = shtCsv_1.Cells(3, 1).Value
        .Cells(3, 9).Value = shtCsv_1.Cells(4, 1).Value
    End With
  
    lngRow = shtWork.Cells(Rows.Count, 40).End(xlUp).row
    varTemp = shtWork.Range(shtWork.Cells(1, 40), shtWork.Cells(lngRow, 47))
    shtReport.Range(shtReport.Cells(5, 10), shtReport.Cells(lngRow + 4, 17)).Value = varTemp


    ' Work初期化
    shtWork.Cells.Delete shift:=xlToLeft
    
    ' CSV初期化
    shtCsv_1.Cells.Delete shift:=xlToLeft
    shtCsv_2.Cells.Delete shift:=xlToLeft
    

    ' --------------------
    ' 集計結果を新しいブックへコピー
    ' --------------------
    
    With shtReport
        .Visible = True
        .Copy
        .Visible = False
        .Cells.Delete shift:=xlToLeft
    End With
    
    GoTo FIN_Yayoi


ErrTrap_Yayoi:

    ' --------------------
    ' エラー処理
    ' --------------------

    MsgBox "エラー番号:" & Err.Number & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
    
    GoTo FIN_Yayoi


FIN_Yayoi:

    ' --------------------
    ' 終了処理
    ' --------------------
   
    ' 処理用シートの印刷範囲の再計算を戻す
    With shtCsv_1
        .DisplayPageBreaks = True
    End With
    
    With shtCsv_2
        .DisplayPageBreaks = True
    End With
    
    With shtWork
        .DisplayPageBreaks = True
    End With
    
    With shtReport
        .DisplayPageBreaks = True
    End With
    
End Sub

' ---------------
' CSVファイルの取り込み処理
' ---------------
Sub subImportCSV(strFilepass As String, mySheet As Worksheet, myRange As Range)

    With mySheet.QueryTables.Add(Connection:="TEXT;" & strFilepass, Destination:=myRange)
        .Name = "CSV取り込み"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        ' ※接続を削除（データ＞接続に残っていなければ成功）
        .Parent.Names(.Name).Delete
        .Delete
    End With

End Sub