vba

pivot用vbaマクロ

Posted on by keeper 
Sub PivotWithMultiCharts_FileSelect()

    Dim f As Variant
    Dim wsData As Worksheet, wsP As Worksheet
    Dim pc As PivotCache, pt As PivotTable
    Dim srcRange As Range
    Dim timeCol As Range, seriesCol As Range, valueCol As Range
    Dim answer As String, chartTypes() As String
    Dim i As Long, co As ChartObject
    
    ' --- データファイルを選択 ---
    f = Application.GetOpenFilename("CSV/Excel Files,*.csv;*.xlsx;*.xls")
    If f = False Then Exit Sub
    
    ' --- 読み込みシート作成 ---
    Set wsData = ThisWorkbook.Sheets.Add
    wsData.Name = "Source" & wsData.Index
    
    ' CSV読み込み（カンマ区切り前提）
    wsData.QueryTables.Add "TEXT;" & f, wsData.Range("A1")
    With wsData.QueryTables(1)
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .Refresh
    End With
    
    Set srcRange = wsData.UsedRange
    
    ' --- 列を選択（時間・系列・値）---
    Set timeCol = Application.InputBox("時間列を選択してください", "列指定", Type:=8)
    Set seriesCol = Application.InputBox("系列列を選択してください", "列指定", Type:=8)
    Set valueCol = Application.InputBox("値列を選択してください", "列指定", Type:=8)
    
    ' --- ピボット用シート ---
    Set wsP = ThisWorkbook.Sheets.Add
    wsP.Name = "Pivot" & wsP.Index
    
    ' --- ピボット作成 ---
    Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcRange)
    Set pt = pc.CreatePivotTable(TableDestination:=wsP.Range("A3"), TableName:="MyPivot")
    
    With pt
        .PivotFields(timeCol.Cells(1, 1).Value).Orientation = xlRowField
        .PivotFields(seriesCol.Cells(1, 1).Value).Orientation = xlColumnField
        .AddDataField .PivotFields(valueCol.Cells(1, 1).Value), "合計", xlSum
    End With
    
    ' --- グラフ種類を入力（カンマ区切り）---
    answer = InputBox("作りたいグラフの種類をカンマ区切りで入力してください。" & vbCrLf & _
                      "例: Line,ColumnClustered,AreaStacked")
    If answer = "" Then Exit Sub
    chartTypes = Split(answer, ",")
    
    ' --- グラフを複数作成 ---
    For i = LBound(chartTypes) To UBound(chartTypes)
        Set co = wsP.ChartObjects.Add(Left:=300, Top:=20 + i * 320, Width:=500, Height:=300)
        co.Chart.SetSourceData Source:=pt.TableRange2
        co.Chart.HasTitle = True
        co.Chart.ChartTitle.Text = "Chart: " & Trim(chartTypes(i))
        
        Select Case Trim(chartTypes(i))
            Case "Line": co.Chart.ChartType = xlLineMarkers
            Case "ColumnClustered": co.Chart.ChartType = xlColumnClustered
            Case "AreaStacked": co.Chart.ChartType = xlAreaStacked
            Case "BarClustered": co.Chart.ChartType = xlBarClustered
            Case "Pie": co.Chart.ChartType = xlPie
            Case Else: co.Chart.ChartType = xlLine
        End Select
    Next i
    
End Sub

keeper