ZチャートをID別(販売担当者, 商品等)に複数個作成するためのマクロ
イントロダクション
数件であればそう煩わしくもないZチャートの作成も,多人数・多商品・多頻度でとなれば煩雑です。この頁では,Excel VBAを使って,複数件の,かつ24ヵ月分のデータにもとづくZチャートを自動的に作成することを試みます。
元データとして,次のような形式の表(24ヵ月分のデータ)を対象とします(このマクロでは必須の形式です)。日々の取引履歴データから「日付」・「(販売)担当者コード(または担当者名・商品コード・商品名など)」・「金額」について抽出した,セルA1からはじまるリスト形式の表です(1行目は必ず見出しとします)。
DL
免責および特記事項
- このマクロはあくまでデモンストレーションを目的としたものです。コードをそのままご利用いただく場合には,お手持ちのデータで従前の方法にて作成したものと内容を照合し,おかしな点が出現しないかどうかを安全な環境で十分に確認してください。精度の不足あるいは予期しないデータ消失等のトラブルにつきまして,筆者は一切責任を負いかねます。
- マクロの動作自体の検証(お使いの環境で正常に動作するか,あるいは処理にどの程度の時間がかかるかといったことの確認)には,このテストデータをExcelにコピペしてお使いいただけます。万一動作中に固まった場合は,[Ctrl]キー+[Pause/Break]キーをお試しください。
- 元データとして数百~数千件のレコード数を想定しています。筆者の環境ではレコード数5000,担当者コード数50まで正常に動作することを確認していますが,処理時間はデータの量に比例して長くなります。
工程
Step 1VBE(Visual Basic Editor)の起動(1)
元データとなるシートを必ずアクティブにしておきます。
次に,開発タブ「コード」グループのVisual Basicボタンをクリックします。
Step 2VBEの操作・VBAコードの導入(1)
VBEの挿入メニュー標準モジュールをクリックします。
Step 3VBEの操作・VBAコードの導入(2) コードのコピー
次のコードをすべて選択し,コピーします。
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
Step 4VBEの操作・VBAコードの導入(3) コードの貼り付け
「標準モジュール」ウインドウにコードを貼り付けます。
Step 5VBEの操作・VBAコードの導入(4)
閉じるボタンをクリックしてVBEを閉じます。
Step 6マクロの実行(1) “AdjustList”
開発タブ「コード」グループのマクロボタンをクリックします。
Step 7マクロの実行(2) “AdjustList”
「マクロ」ダイアログが表示されます。
「マクロ名」に2つのマクロが表示されています。ここでは「AdjustList」の方を選択して,実行ボタンをクリックします。
Step 8マクロの実行(3) “AdjustList”
マクロ「AdjustList」の処理が始まります。データの大きさにしたがって,しばらく処理時間が必要な場合があります。処理が終わると,元のシートが右方にコピーされ,「年-月」というデータ列が作成されます。このとき,シート名は自動で「ピボット表作成用シート」とされます。
Step 9ピボット表の作成(1)
挿入タブ「テーブル」グループのピボットテーブルボタンをクリックします。
Step 10ピボット表の作成(2)
「ピボットテーブルの作成」ダイアログが表示されます。ピボットテーブルを配置する場所が「新規ワークシート」になっていることを確認して,OKボタンをクリックします。
Step 11ピボット表の作成(3)
あたらしいシートにピボット表が作成されます。
フィールドリストから,「年-月」を「行ラベル」枠内に,「担当者コード」を「列ラベル」枠内に,そして「金額」を「値」枠内にドラッグ&ドロップします。
Step 12マクロの実行(1) “CreateMultiZchart”
念のため,ピボット表がアクティブな状態になっているか確認します。続けて 開発タブ「コード」グループのマクロボタンをクリックします。
Step 13マクロの実行(2) “CreateMultiZchart”
「マクロ」ダイアログが表示されます。
「マクロ名」に2つのマクロが表示されています。今度は「CreateMultiZchart」の方を選択して,実行ボタンをクリックします。
Step 14Zチャートの一括作成・完了
マクロ「CreateMultiZchart」の処理が始まります。データの大きさにしたがって,しばらく処理時間が必要な場合があります。このマクロは,おおきく
- あたらしいブックを作成
- 項目ごとにデータシートを作成
- 項目ごとにグラフシート(Zチャート)を作成
の順に処理をすすめます。完成したブックの,シート群左サイドの色のついてないシートがZチャートの元表で,同右サイドの赤い色のシートがZチャートです。
その他の参照
このサイトの関連How-toです。
メインサイト「ひとりマーケティングのためのデータ分析」の関連How-toです。