Option Explicit

'dataという名前のワークシートを予め作成しておいて下さい
Public Sub PasteCsvData()
    Dim fs As New Scripting.FileSystemObject
    Dim file As Scripting.file
    Dim files As Scripting.files
    Dim vlist() As Variant
    Dim gyo As Long
    Dim cnt As Long 'カウント用
    cnt = 1
    Dim wsData As Worksheet 'csvデータ書き込み先
    Dim fName As String
    
    Set wsData = Workbooks("BusinessReport.xlsm").Worksheets("data")
    
    
    '-----------------------------------------
    
     MsgBox "CSVファイルが保存されているフォルダを選択してください。"
    '[1]FileDialogオブジェクトを使う方法
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Set files = fs.GetFolder(.SelectedItems(1)).files
        Else
            Exit Sub
        End If
    End With
    '[2]ファイル拡張子でcsvを判定
    For Each file In files
        If LCase(fs.GetExtensionName(file)) <> "csv" Then
            MsgBox "CSVファイル以外のファイルが含まれるため実行できません。"
            Exit Sub
        End If
    Next
    
  '-----------------------------------------
    
    For Each file In files
        
        'ファイルを開く
        Workbooks.Open (file)
        
        fName = Right(fs.GetBaseName(file), 8) 'ファイル名の日付部分のみを取得

        'csvデータを配列に格納し、その後書き出す
        gyo = wsData.Range("B" & Rows.Count).End(xlUp).Row

        '1回目はタイトル行含む
        If cnt = 1 Then
            vlist = Range("A1").CurrentRegion
            wsData.Range("B1").Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A1").Value = "日付"
            wsData.Range("A2" & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        Else
        '2回目以降はタイトル行を除く
            vlist = Range("A1").CurrentRegion.Offset(1, 0).Resize(Range("A1").CurrentRegion.Offset(1, 0).Rows.Count - 1)
            wsData.Range("B" & gyo + 1).Resize(UBound(vlist, 1), UBound(vlist, 2)).Value = vlist
            wsData.Range("A" & gyo + 1 & ":A" & wsData.Range("B" & Rows.Count).End(xlUp).Row).Value = fName
        End If
        ActiveWorkbook.Close
        cnt = cnt + 1
    Next
    
   Set file = Nothing
   Set fs = Nothing
    
End Sub

Option Explicit

    Dim wsSaki As Worksheet
    Dim wsMoto As Worksheet
    
Public Sub CreateGraph()
    Dim ar() As Variant
    Dim ans As Long '調べたいデータ
    
    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    ans = InputBox("数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", "データ集計", "")


    If ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

    '初期化
    wsSaki.Range("A1").CurrentRegion.ClearContents
    '横軸（日付）の書き出し
    ar() = CreateAxis("A", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 2), UBound(ar, 1)).Value = _
    Application.WorksheetFunction.Transpose(ar)
    
    Erase ar
    
    '縦軸（商品番号）の書き出し
    ar() = CreateAxis("C", "B")
    '貼り付け
    wsSaki.Range("A1").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar
    
    '値を表の中に書き出し
    CreateValue ans
    
End Sub

Private Sub CreateValue(ans As Long)

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim vlist As Variant
    Dim Col As Long
    Dim Lrow As Long
    Dim c As Long
    Dim gyo As Long
    Dim retsu As Long
    
    'データを一気に配列に格納
    vlist = wsMoto.Range("A1").CurrentRegion
    '最終列を調査
    Col = wsSaki.Range("A1").End(xlToRight).Column - 2
    '最終行を調査
    Lrow = wsSaki.Range("A" & Rows.Count).End(xlUp).Row - 2
    
    For c = LBound(vlist, 1) + 1 To UBound(vlist, 1)
        For gyo = 0 To Lrow
        If Range("A2").Offset(gyo).Value = vlist(c, 3) Then
            For retsu = 0 To Col
            If Range("B1").Offset(, retsu).Value = vlist(c, 1) Then
                Range("B2").Offset(gyo, retsu).Value = vlist(c, ans) '調べたい値が入力
                Exit For
            End If
            Next
        Exit For
        End If
        Next
    Next

    
End Sub

Function CreateAxis(R1 As String, R2 As String) As Variant()
    Dim arDate() As Variant

    Set wsSaki = ThisWorkbook.Worksheets("graph")
    Set wsMoto = ThisWorkbook.Worksheets("data")
    
    Dim lastR As Long
    
    'データをコピーし貼り付け
    lastR = wsMoto.Range(R1 & Rows.Count).End(xlUp).Row
    'A列日付の貼り付け
    wsMoto.Range(R1 & "1:" & R1 & lastR).Copy
    'とりあえず関係無い所B3に書き出している
    wsSaki.Range(R2 & "3").PasteSpecial xlPasteValues
    
    '重複データを除去
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    wsSaki.Range(R2 & "3:" & R2 & lastR).RemoveDuplicates Columns:=1, Header:=xlYes
    
    '配列に格納
    lastR = wsSaki.Range(R2 & Rows.Count).End(xlUp).Row
    arDate = wsSaki.Range(R2 & "3:" & R2 & lastR).Value
    wsSaki.Range(R2 & "3:" & R2 & lastR).ClearContents
    
    CreateAxis = arDate()
    
End Function

Sub dsum_sample()
    Dim rData As Range, rCondition As Range
    Set rData = Range("A1").CurrentRegion
    Set rCondition = Range("I1").CurrentRegion
    
    'DSum関数をworksheetfunctionで使うための動作確認(セルN2に埋め込んだ関数式も参考のこと)
    Debug.Print WorksheetFunction.DSum(rData, "仕入金額", rCondition)
    
    Dim i As Integer, j As Integer, k As Integer
    Dim iYear(1) As Integer, iMonth(11) As Integer, sShohin(2) As String
    iYear(0) = 2005
    iYear(1) = 2006

    For j = LBound(iMonth) To UBound(iMonth)
        iMonth(j) = j + 1
    Next

    sShohin(0) = "あま酒"
    sShohin(1) = "ふりかけ"
    sShohin(2) = "みそピー"

    
    Dim gyo As Integer
    Const cBase As Long = 6
    
    '仕入年ごとの仕入額総計
    gyo = cBase
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        Range("I" & gyo).Value = iYear(i) & "年"
        Range("J" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
        gyo = cBase + 1
    Next

    '仕入年ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For k = LBound(sShohin) To UBound(sShohin)
            Range("K2").Value = sShohin(k)
            Range("I" & gyo).Value = iYear(i) & "年"
            Range("J" & gyo).Value = sShohin(k)
            Range("K" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
            gyo = gyo + 1
        Next
    Next

    '仕入年月ごと、商品ごとの仕入額総計
    gyo = gyo + 2
    rCondition.Offset(1).Clear
    For i = LBound(iYear) To UBound(iYear)
        Range("I2").Value = iYear(i)
        For j = LBound(iMonth) To UBound(iMonth)
            Range("J2").Value = iMonth(j)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("K2").Value = sShohin(k)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = WorksheetFunction.DSum(rData, "仕入金額", rCondition)
                gyo = gyo + 1
            Next
        Next
    Next
End Sub

    Dim ans As Variant 'キャンセル対応でVariant型に変更
    ans = Application.InputBox(Prompt:="数字を入力して下さい" & vbCrLf & "セッション：5" & _
    vbCrLf & "ページビュー：7" & vbCrLf & "カートボックス獲得率：9" & _
    vbCrLf & "商品購入率：11" & vbCrLf & "注文商品売上：12", Title:="データ集計", Type:=1)
 
    If VarType(ans) = vbBoolean Then
        MsgBox "キャンセルされました。"
        Exit Sub
    ElseIf ans <> 5 And ans <> 7 And ans <> 9 And ans <> 11 And ans <> 12 Then
        MsgBox "集計できません"
        Exit Sub
    End If

　…途中略…

    '値を表の中に書き出し
    CreateValue CLng(ans)  'Long型にキャストして渡す必要あり

Sub hoge()
    Dim ret As Variant
    Dim bOk As Boolean
    bOk = False
    Do
        ret = Application.InputBox(Prompt:="5, 7, 9, 11, 12 のどれかを入力してください", Type:=1)
        Select Case LCase(TypeName(ret))
            Case "boolean"
                MsgBox "キャンセルされました"
                Exit Sub
            Case Else ' "double"
                Select Case CInt(ret)
                    Case 5, 7, 9, 11, 12
                        bOk = True
                    Case Else
                        bOk = False
                End Select
            End Select
    Loop Until bOk
    Debug.Print ret
End Sub

'メインの処理を簡潔にしたバージョン
Sub fuga()
    Const prompt_string As String = "5, 7, 9, 11, 12 のどれかを入力してください"
    Dim ret As Variant
    Do
        ret = Application.InputBox(Prompt:=prompt_string, Type:=1)
        If TypeName(ret) = "Boolean" Then
            MsgBox "キャンセルされました"
            Exit Sub
        End If
    Loop Until is_valid(ret)
    Debug.Print ret
End Sub
Function is_valid(ret As Variant) As Boolean
    Select Case ret
        Case 5, 7, 9, 11, 12
            is_valid = True
        Case Else
            is_valid = False
    End Select
End Function

Sub sumifs_sample()
    'SumIfs関数でDsum関数と同じことをしてみた by Tanaka
    Dim sfData As Range '仕入金額
    Dim rData1 As Range '仕入年
    Dim rData2 As Range '仕入月
    Dim rData3 As Range '商品名

    Set sfData = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)
    Set rData1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Set rData2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Set rData3 = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
    
    Dim i As Integer, j As Integer, k As Integer
    Dim iYear(1) As Integer, iMonth(11) As Integer, sShohin(2) As String
    iYear(0) = 2005
    iYear(1) = 2006

    For j = LBound(iMonth) To UBound(iMonth)
        iMonth(j) = j + 1
    Next

    sShohin(0) = "あま酒"
    sShohin(1) = "ふりかけ"
    sShohin(2) = "みそピー"
    
    Dim gyo As Integer
    
    '仕入年月ごと、商品ごとの仕入額総計
    gyo = 6
    For i = LBound(iYear) To UBound(iYear)
        For j = LBound(iMonth) To UBound(iMonth)
            For k = LBound(sShohin) To UBound(sShohin)
                Range("I" & gyo).Value = iYear(i) & "年"
                Range("J" & gyo).Value = iMonth(j) & "月"
                Range("K" & gyo).Value = sShohin(k)
                Range("L" & gyo).Value = _
                WorksheetFunction.SumIfs(sfData, rData1, iYear(i), rData2, iMonth(j), rData3, sShohin(k))
                gyo = gyo + 1
            Next
        Next
    Next
End Sub