売上げ情報ファイル作成用コード

Option Explicit
 
Sub 売上げ情報フォルダ作成()
    
    Dim path As String
     
    path = ThisWorkbook.Path & "\売上げ情報"
    
    MkDir path
    
End Sub
Sub 単価テーブル作成()
    Dim wb As Workbook
    Dim ws As Worksheet
     
    Dim path As String
     
    path = ThisWorkbook.Path & "\"
    
    Set wb = Workbooks.Add
    wb.SaveAs path & "単価テーブル.xlsx"
    
    Set ws = wb.Worksheets(1)
    
    ws.Cells(1, 1) = "商品"
    ws.Cells(1, 2) = "単価"
    
    ws.Cells(2, 1) = "醤油ラーメン"
    ws.Cells(2, 2) = 800
    
    ws.Cells(3, 1) = "塩ラーメン"
    ws.Cells(3, 2) = 750
    
    ws.Cells(4, 1) = "味噌ラーメン"
    ws.Cells(4, 2) = 850
    
    ws.Cells(5, 1) = "チャーシューメン"
    ws.Cells(5, 2) = 900
    
    ws.Cells(6, 1) = "餃子"
    ws.Cells(6, 2) = 250
    
    ws.Cells(7, 1) = "ライス"
    ws.Cells(7, 2) = 150
    
    ws.Cells(8, 1) = "ビール"
    ws.Cells(8, 2) = 500
    
    ws.Cells(9, 1) = "ウーロン茶"
    ws.Cells(9, 2) = 150
    
    wb.Close savechanges:=True
        
End Sub

Sub 集計結果ファイル作成()
    Dim wb As Workbook
    Dim ws As Worksheet
     
    Dim i As Long
     
    Dim path As String
     
    path = ThisWorkbook.Path & "\"
    
    Set wb = Workbooks.Add
    wb.SaveAs path & "集計結果.xlsm", _
                        FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    For i = 1 To 3
        wb.Worksheets.Add
    Next
    
    wb.Worksheets(1).Name = "集計結果"
    wb.Worksheets(2).Name = "wk_ファイル一覧"
    wb.Worksheets(3).Name = "wk_売上げ情報一覧"
    wb.Worksheets(4).Name = "wk_売上げ情報一覧_sorted"

    Set ws = wb.Worksheets("集計結果")
    
    ws.Cells(1, 1) = "商品"
    ws.Cells(1, 2) = "年月"
    ws.Cells(1, 3) = "売上数量"
    ws.Cells(1, 4) = "売上金額"
    
    wb.Close savechanges:=True
        
End Sub

Sub 売上げ情報ファイル_作成()
    Dim wb As Workbook
     
    Dim i As Long
     
    Dim path As String
     
    path = ThisWorkbook.Path & "\売上げ情報\"
     
    For i = 6 To 12
         
        Set wb = Workbooks.Add
        wb.SaveAs path & "2021年" & WorksheetFunction.Text(Str(i), "00") & "月" & ".xlsx"
        wb.Close savechanges:=False
    Next
         
End Sub
 
Sub 売上げ情報ファイル_中身記述()
    Dim wb As Workbook
    Dim ws As Worksheet
     
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
     
    Dim path As String
    Dim fileName As String
     
    Dim fileYear As String
    Dim fileMonth As String
    Dim fileDate As Date
     
    Dim wk_fileName As String
 
    path = ThisWorkbook.Path & "\売上げ情報\"
    fileName = Dir(WorksheetFunction.Concat(path, "*.xlsx"))
     
    Do Until fileName = ""
         
        Set wb = Workbooks.Open(path & fileName)
        Set ws = wb.Worksheets(1)
         
        fileYear = LeftB(fileName, 8)
        fileMonth = MidB(fileName, 11, 4)
        fileDate = CDate(fileYear & "/" & fileMonth & "/01")
         
        ws.Cells(1, 1) = "日付"
        ws.Cells(1, 2) = "商品"
        ws.Cells(1, 3) = "売上数量"
         
        j = Int(Format(DateSerial(Year(fileDate), Month(fileDate), 1), "yyyymmdd"))
        k = Int(Format(DateSerial(Year(fileDate), Month(fileDate) + 1, 0), "yyyymmdd"))
         
        l = 2
        For i = j To k
             
            wk_fileName = Str(i)
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "醤油ラーメン"
            ws.Cells(l, 3) = Int(20 * Rnd + 15)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "塩ラーメン"
            ws.Cells(l, 3) = Int(30 * Rnd + 20)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "味噌ラーメン"
            ws.Cells(l, 3) = Int(40 * Rnd + 25)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "チャーシューメン"
            ws.Cells(l, 3) = Int(20 * Rnd + 20)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "餃子"
            ws.Cells(l, 3) = Int(70 * Rnd + 60)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "ライス"
            ws.Cells(l, 3) = Int(70 * Rnd + 65)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "ビール"
            ws.Cells(l, 3) = Int(30 * Rnd + 20)
             
            l = l + 1
             
            ws.Cells(l, 1) = MidB(wk_fileName, 3, 8) & "/" & MidB(wk_fileName, 11, 4) & "/" & MidB(wk_fileName, 15, 4)
            ws.Cells(l, 2) = "ウーロン茶"
            ws.Cells(l, 3) = Int(40 * Rnd + 40)
             
            l = l + 1
             
        Next
         
        wb.Close savechanges:=True
         
        fileName = Dir()
         
    Loop
     
End Sub
 
Sub 連続実行()
     
    Application.ScreenUpdating = False
    Call 売上げ情報フォルダ作成
    Call 単価テーブル作成
    Call 集計結果ファイル作成
    Call 売上げ情報ファイル_作成
    Call 売上げ情報ファイル_中身記述
    Application.ScreenUpdating = True

    MsgBox "ファイルの作成完了！"
    
End Sub