1. まとめトップ

【Excel】自動でグラフを作成!【VBA】

Excelはとても便利!大量のデータがあり、グラフを色んな組み合わせで作らなければならず1日1時間以上かかる…プログラムで業務効率化しましょう!データを抽出し、それにあわせてグラフを毎回作らないといけない…そんなの面倒ですものねw自動でグラフ化!編集中【VBA】

更新日: 2017年07月18日

Mochihaさん

  • このまとめをはてなブックマークに追加
3 お気に入り 7691 view
お気に入り追加

まとめ

よく使うグラフ

xlBarClustered     集合横棒
xlBarStacked      積み上げ横棒
xlBarStacked100    100% 積み上げ横棒
xlColumnClustered   集合縦棒
xlColumnStacked     積み上げ縦棒
xlColumnStacked100   100% 積み上げ縦棒
xlLine          折れ線
xlLineMarkers     マーカー付き折れ線
xlRadar         レーダー
xlXYScatter       散布図
xlArea          面

グラフを3列作成

test…グラフを作成するためのデータを取得する場所
makeGraph…取得したデータに従い、グラフを整形する場所

改善版

前回のが良くなかったので書き直します。

データは全て3行目から。
2行目は見出し。

A列:科目
B列:クラス
C列:点数
D列:点数
E列:点数
F列:点数
G列:点数

科目ごとに、点数の推移を見ていこう!
(ボタンひとつで自動グラフ化しちゃおう!)

ユーザーフォームの作成

ALT+F11キーを押すと、プログラムを書き込める画面が表示されます。
(画像のは、Excel2003です)
大差ないと思いますので、説明を続けます。

ユーザーフォーム等関係なく
使えるプログラムを書くところです。

追加すると、右側にプログラムを書き込める画面が
表示されます。

とりあえずスルーで。

次に、また適当なところを右クリックして
「挿入(N)」→ユーザーフォームを
追加しましょう。

追加すると、UserFormが表示されます。

プログラム実行用(マクロ登録)ボタン自動作成

「起動」というボタンをA1セルに作成し、
ボタンを押したら「TESTMACRO」を実行させます

Sub ButtonCreate()
With ActiveSheet.Buttons.Add(Range("A1").Left, _
Range("A1").Top, _
Range("A1").Width, _
Range("A1").Height)
.OnAction = "TESTMACRO"
.Characters.Text = "起動"
.Characters.Font.Size = 8

End With
End Sub

シートがある場合、削除して作り直し

グラフがあるからといって、毎回グラフを削除して作り直すと
時間がかかってしまいます。
なので、シートごと削除して作り直すことにします!

シートがあるかないか、存在を確認してあった場合は作り直し!
無かったら新しく作ります。
Call SheetBeing("ダミー") と呼び出せば、ダミーシートを作成することが出来ます。

シートの存在確認、シート削除して新規作成編

Sub SheetBeing(WorkSheet_NEWNAME) 'シート存在しますか?
 Application.ScreenUpdating = False

  Dim ws As Worksheet, flag As Boolean

 For Each ws In Worksheets
  If ws.Name = WorkSheet_NEWNAME Then
  flag = True
  End If
 Next ws

 If flag = True Then 'シートがある場合
  Application.DisplayAlerts = False '削除の際、忠告を出さない
  Worksheets(WorkSheet_NEWNAME).Delete 'シート削除
  Application.DisplayAlerts = True

  Worksheets.Add after:=Worksheets(2) '3番目の位置に
  ActiveSheet.Name = WorkSheet_NEWNAME '新しいシート作成
 Else
  Worksheets.Add after:=Worksheets(2) '3番目の位置に
  ActiveSheet.Name = WorkSheet_NEWNAME '新しいシート作成
 End If

End Sub

フィルター後のシートの可視セルをコピーする

C1セルにフィルターをかけたい内容があるとします。
Field:=Range("C1").column で、C1列を選択。
Criteria1:=ComboBox1.value で
コンボボックスに表示されている内容でフィルターをかけることになります

例えば。
D列を"テスト"という内容でフィルターをかけたい場合は
Selection.AutoFilter Field:=Range("D1").Column, Criteria1:="テスト"
という風になります

最初のSelection部分も
Workbooks("テストブック").Worksheets("ダミー").range("A1").CurrentRegion
としてもOKです。

フィルターについて詳しくはこちら
https://matome.naver.jp/odai/2143208158655847001

Worksheets("ダミー").Activate 'ダミーシートをアクティブに
Selection.AutoFilter Field:=Range("C1").Column, Criteria1:=ComboBox1.Value 'コンボボックスの内容をフィルタ
Selection.SpecialCells(xlCellTypeVisible).Select '可視セルの選択
Selection.Copy '可視セルコピー

グラフ作成

Sub MakeGraph()
Dim dataRange As Range, myArea As Range, targetRange As Range
Dim sh As Worksheet
Dim Counter As Long, graphColumns As Long
Dim myLeft As Double, myTop As Double, myWidth As Double, myHeight As Double
Dim xOffset As Double, yOffset As Double
Dim chartObj() As ChartObject

 graphColumns = 3 'グラフを何列に並べるか。1列で良いのなら、1で構わない
 myWidth = 200: myHeight = 150'グラフの幅myWidth 高さmyHeight 
 xOffset = 20: yOffset = 20'グラフを複数配置する場合の間隔
 Set sh = ActiveSheet'アクティブシートのグラフを作成する
With sh'アクティブシートのA2からA最終行までの範囲をdataRange変数に入れる
 Set dataRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
 Counter = 0'グラフの個数カウント
 'dataRangeの値が入っている部分を取得し
 'myAreaにA列で値が入っている一塊のセル範囲をあてはめる
For Each myArea In dataRange.SpecialCells(xlCellTypeConstants).Areas
 '取得した範囲の一行目を切り捨て、3列に拡大した範囲を取得
 Set targetRange = Intersect(myArea, myArea.Offset(1, 0)).Resize(, 3)
 'MyLeft 150は、Excelシートの左から150ずらした位置からグラフ開始ということ
 myLeft = 150 + (Counter Mod graphColumns) * (myWidth + xOffset)
 ’10は、Excelシート上から10ずらした位置からグラフ開始ということ。
 myTop = 10 + (Counter / graphColumns) * (myHeight + yOffset)
 ReDim Preserve chartObj(0 To Counter)
 'chartObj(0)のように、配列にグラフを追加する
 Set chartObj(Counter) = sh.ChartObjects.Add(myLeft, myTop, myWidth, myHeight)
 '追加したグラフの詳細設定をmakeGraphで行う
 makeGraph targetRange, chartObj(Counter)
 Counter = Counter + 1
Next myArea
End Sub

makeGraph

項目軸の設定や、タイトル表示設定、値表示設定等
各グラフの詳細設定を行う

Sub makeGraph(myRange As Range, myChartObj As ChartObject)
Dim mySeries As Series
Dim i As Long

With myChartObj.Chart
 Set mySeries = .SeriesCollection.NewSeries
'X軸項目は、Columns(1) 1列目の範囲を利用する
 mySeries.XValues = myRange.Columns(1)
'値は、Columns(2) 2列目の範囲を利用する
 mySeries.Values = myRange.Columns(2)
 .ChartType = xlColumnClustered'集合縦棒
 .HasTitle = True'タイトルを表示する
 .HasLegend = False'凡例を表示しない
 .ChartTitle.Text = myRange.Cells(1).Item(0).Value'タイトルのテキスト
End With
For i = 1 To mySeries.Points.Count
 With mySeries.Points(i)
 .HasDataLabel = True
 .DataLabel.Text = myRange.Columns(3).Cells(i).Value
 End With
Next i
End Sub

1 2





興味があるものいついて書きます。面倒なことが嫌いで効率化が好きです。
気に入ったら「お気に入り」を
良い情報だったら友達と共有して頂けると嬉しいです!
プログラム関連についてもまとめていきます。