Sub CreateMultiZchart()

' Zチャートの一括作成 ver.16.0214
' bdastyle.net/tools/z-chart/page1.html
' by hawcas 2013, 2016

On Error GoTo myError

Dim psn As Long                 ' 人数(総計を含む)
Dim cLabel() As String          ' 列見出し(IDor名前：総計を含む)
Dim rLabel(24) As String        ' 行見出し(時間の区分：24個)
Dim xValue() As Variant            ' 値
Dim wbnam As String             ' あたらしいブック名
Dim stnam As String             ' シート名
Dim xChart As Chart
Dim x As Long                   ' 以下カウンタ
Dim y As Long
Dim i As Long

' ピボット表より各データを変数に格納
psn = Range("A4").End(xlToRight).Column - 1     ' 人数
ReDim cLabel(psn)
ReDim xValue(psn, 24)

For i = 1 To psn    ' 列見出し(IDor名前)
    cLabel(i) = Range("B4").Offset(0, 0 + i - 1).Value
Next

For i = 1 To 24     ' 行見出し(時間の区分)
    rLabel(i) = Range("A5").Offset(0 + i - 1, 0).Value
Next

For x = 1 To psn    ' 値
    For y = 1 To 24
        xValue(x, y) = Range("B5").Offset(0 + y - 1, 0 + x - 1).Value
    Next
Next

' ブック・シートの作成
Workbooks.Add       ' ブックを追加
wbnam = ActiveWorkbook.Name

For i = 1 To psn    ' シートをpsn枚追加
    Worksheets.Add
Next

For i = 1 To psn    ' シート名を変更
    Worksheets(i).Name = cLabel(i)
Next

' データ表(年-月・売上・売上累計・移動年計表)の作成
For x = 1 To psn    ' 個人別に
    stnam = cLabel(x)
    Worksheets(stnam).Select
    Range("B1").Value = "売上"
    Range("C1").Value = "売上累計"
    Range("D1").Value = "移動年計"
    For y = 1 To 24 ' 24の時間区分
        Range("A2").Offset(0 + y - 1, 0) = rLabel(y)    ' 行ラベルと
        Range("A2").Offset(0 + y - 1, 1) = xValue(x, y) ' 値を転記
    Next
    Range("B26") = _
    Application.WorksheetFunction.Sum(Range("B2:B25"))  ' 値の合計(検算用・削除可)
Next

For x = 1 To psn    ' 売上累計の計算
    stnam = cLabel(x)
    Worksheets(stnam).Select
    For y = 1 To 12
        Range("C2").Offset(12 + y - 1, 0) = _
        Application.WorksheetFunction.Sum(Range(Cells(14, 2), _
        Cells(14, 2).Offset(0 + y - 1, 0)))
    Next
Next

For x = 1 To psn    ' 移動年計の計算(とグラフの埋め込み)
    stnam = cLabel(x)
    Worksheets(stnam).Select
    For y = 1 To 12
        Range("D2").Offset(12 + y - 1, 0) = _
        Application.WorksheetFunction.Sum(Range(Cells(3, 2).Offset(0 + y - 1, 0), _
        Cells(14, 2).Offset(0 + y - 1, 0)))
    Next
       
' ★★★ グラフをデータ表に埋め込みたい場合…
' これより下14行の先頭のアポストロフィ(')を削除し、▲▲▲で囲まれた部分のコードを削除
    'ActiveSheet.Shapes.AddChart(xlLineMarkers, , , 380, 295).Select ' 横:380px 縦：295pxで作成
    'With ActiveChart
    '    .ChartType = xlLineMarkers
    '    .SetSourceData Source:=Range("$A$1:$D$1, $A$14:$D$25")
    '    .HasTitle = True
    '    .ChartTitle.Text = cLabel(x)   ' グラフタイトルをIDまたは名前に
    '    .Axes(xlValue).DisplayUnit = xlMillions    ' 数値軸の表示単位を「百万」に(xlMillionsを必要に応じて変更してください)
    'End With
    'With ActiveChart.PlotArea  ' プロットエリア　サイズの調整
    '    .Top = 20   ' 上端より20px
    '    .Left = 20  ' 左端より20px
    '    .Height = 260   ' 高さ260px
    '    .Width = 270    ' 幅270px　で仮調整
    'End With
' ★★★

Next

' ▲▲▲　グラフシートの作成
For i = psn To 1 Step -1
    stnam = cLabel(i)

    Set xChart = Charts.Add(after:=Sheets("総計"))

    With xChart
        .ChartType = xlLineMarkers
        .SetSourceData Source:=Worksheets(stnam).Range("$A$1:$D$1, $A$14:$D$25")
        .HasTitle = True
        .ChartTitle.Text = cLabel(i)   ' グラフタイトルをIDまたは名前に
        .Axes(xlValue).DisplayUnit = xlMillions    ' 数値軸の表示単位を「百万」に(xlMillionsを必要に応じて変更してください)
    End With

    ActiveSheet.Tab.ColorIndex = 3  ' グラフシートのタブ色を赤に
    ActiveSheet.Name = "Chart-" & cLabel(i) ' シート名を「Chart-IDor名前」に変更
Next
' ▲▲▲

Exit Sub

myError:
    MsgBox "実行時エラーが発生しました。処理を終了します。"

End Sub

Sub AdjustList()

' ***　Zチャートの一括作成 元表調整

On Error GoTo myError

Dim EoR As Long         ' 最下行番号
Dim xDATE As String     ' 日付
Dim xYear As String     ' 年
Dim xMonth As String    ' 月
Dim y As Long           ' カウンタ

ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "ピボット表作成用シート"

EoR = Range("A1").End(xlDown).Row

Columns("B:B").Insert shift:=xlShiftToRight
Columns("B:B").NumberFormatLocal = "@"
Range(Range("A1").Offset(1, 0), Range("A1").Offset(EoR - 1, 0)).NumberFormatLocal = "yyyy/mm/dd"

Range("B1").Value = "年-月"
For y = 1 To EoR - 1
    xDATE = Str(Range("A1").Offset(0 + y, 0).Value)
    xYear = Mid(xDATE, 1, 4)
    xMonth = Mid(xDATE, 6, 2)
    Range("B1").Offset(0 + y, 0).Value = xYear & "-" & xMonth
Next
Exit Sub

myError:
    MsgBox "実行時エラーが発生しました。処理を終了します。"

End Sub