質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

2227閲覧

VBAでグラフを一括でつくる

izuki_y

総合スコア65

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/06/30 00:20

お世話になっております。
表題の件で質問をさせてください。

環境:
Windows 10 Pro x64
Excel 2016

前回の質問を元にVBAでグラフ作成までを完成させました。
VBAでグラフを作るとExcelが落ちる
VBAでグラフの特定要素を色付けしたい

最後に複数の表で各列毎(月ごと)にグラフを作りたいです。
二次元!!

VBA

1Option Explicit 2Sub AddGraph() 3 4 'グラフの対象データ範囲を定義 5 Dim trgtSh As Worksheet 6 Set trgtSh = ThisWorkbook.Worksheets("Sheet1") 7 Dim dataRng As Range 8 Set dataRng = trgtSh.Range("A1").CurrentRegion '行が増えても大丈夫 9 10 11 'グラフを貼り付けたいセルを定義 12 Dim pasteRng As Range 13 Set pasteRng = trgtSh.Range("D6") 14 15 'グラフの対象データをソートする(昇順) 16 ' 複数列の場合はここも変えないといけない 17 With trgtSh 18 .Sort.SortFields.Clear 19 .Sort.SortFields.Add Key:=.Range("B1"), Order:=xlAscending '第1優先 20 .Sort.SortFields.Add Key:=.Range("A1"), Order:=xlAscending '第2優先 21 .Sort.SetRange dataRng 'ソートの範囲 22 .Sort.Header = xlYes '先頭のセルはヘッダ?それともデータ? 23 .Sort.Apply 24 End With 25 26 'グラフ編集 27 With trgtSh.Shapes.AddChart2.Chart 28 29 'グラフの種類を指定(ここでは「集合縦棒」) 30 .ChartType = xlColumnClustered 31 'グラフの対象データ範囲を指定 32 .SetSourceData dataRng 33 34 Dim tmp As Variant, I As Long 35 tmp = .SeriesCollection(1).XValues 36 37 For I = 1 To UBound(tmp) 38 If InStr(tmp(I), "Product 10") > 0 Then 39 With .SeriesCollection(1).Points(I) 40 .Interior.ColorIndex = 3 41 .ApplyDataLabels 42 End With 43 End If 44 45 'グラフタイトルを非表示 46 .HasTitle = False 47 48 'グラフのフォントを"Meiryo UI"、フォントサイズを"10"にする 49 With .ChartArea.Format.TextFrame2.TextRange.Font 50 .Size = 10 51 .NameComplexScript = "Meiryo UI" 52 .NameFarEast = "Meiryo UI" 53 .Name = "Meiryo UI" 54 End With 55 56 57 'グラフの貼り付け位置を指定 58 .Parent.Top = pasteRng.Top 59 .Parent.Left = pasteRng.Left 60 End With 61 62End Sub

ご教授よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

izuki_y

2020/06/30 00:24

作るだけたら選択範囲を変更すれば出来るとおもったけどグラフの表示を昇順ソートしてくれと言われた。 これはもう別セルにグラフ用の分解した表を作るしかないのかもしれない
radames1000

2020/07/01 00:15

1月グラフを作成後2月データでソートすると1月グラフの並びが崩れます。 対処案としては二つ思いつきました。 1.別表を作成する 2.一度作ったグラフを画像にする どれが質問者さんの意図に沿うでしょうか。
izuki_y

2020/07/03 15:36

返信が遅れて申し訳ありません。 ご回答ありがとうございます。 内容に関しては仰る通りです。 画像だとペーストのパラメータを変更させればよいので楽かなと思いますが、 汎用性が無くなるので個人的にはNGかなと思っています。 別表を作ってそれぞれで表を作成するのが一番かなと思っております。 作業が滞っていた間に、「ソートしろ」、「MinとMaxの要素に対してデータラベルの追加を行え」、「月ごとのAverage(平均)を追加して色を変更しろ」と次々に注文が入って困りますw tosiさんソースをベースに変更してみようと思います。 同じ様に別表を作る関数を作ってやってみようと思います。 また困った事がありましたら是非協力をお願いいたします。
guest

回答2

0

ベストアンサー

こんな感じでしょうか。(修正を加えてみました)

VBA

1Option Explicit 2 3Sub Test_Sample_Miniature() 4 5 Dim WorkChart As Chart 6 Dim lngTop As Long, lngHeight As Long 7 8 Set WorkChart = AddGraph("A1:A17,B1:C17", "A1") 9 lngTop = WorkChart.Parent.Top + WorkChart.Parent.Height 10 11 Set WorkChart = AddGraph("A1:A17,B1:B17", "A1") 12 WorkChart.Parent.Top = lngTop 13 lngTop = lngTop + WorkChart.Parent.Height 14 15 Set WorkChart = AddGraph("A1:A17,C1:C17", "A1") 16 WorkChart.Parent.Top = lngTop 17 lngTop = lngTop + WorkChart.Parent.Height 18 19 Set WorkChart = AddGraph("A1:A17,D1:D17", "A1") 20 WorkChart.Parent.Top = lngTop 21 22End Sub 23 24Function AddGraph(ByVal strDataArea As String, ByVal strKeySel As String) As Chart 25 26 'グラフの対象データ範囲を定義 27 Dim trgtSh As Worksheet 28 Set trgtSh = ThisWorkbook.Worksheets("Sheet1") 29 Dim dataRng As Range 30 Set dataRng = trgtSh.Range("A1").CurrentRegion '行が増えても大丈夫 31 32 33 'グラフを貼り付けたいセルを定義 34 Dim pasteRng As Range 35 Set pasteRng = trgtSh.Range("D6") 36 37 'グラフの対象データをソートする(昇順) 38 ' 複数列の場合はここも変えないといけない 39 With trgtSh 40 .Range(strDataArea).Select 41 .Sort.SortFields.Clear 42 .Sort.SortFields.Add Key:=.Range(strKeySel), Order:=xlAscending '第1優先 43 .Sort.SortFields.Add Key:=.Range("A1"), Order:=xlAscending '第2優先 44 .Sort.SetRange dataRng 'ソートの範囲 45 .Sort.Header = xlYes '先頭のセルはヘッダ?それともデータ? 46 .Sort.Apply 47 End With 48 49 'グラフ編集 50 Set AddGraph = trgtSh.Shapes.AddChart.Chart 51 With AddGraph 52 53 'グラフの種類を指定(ここでは「集合縦棒」) 54 .ChartType = xlColumnClustered 55 56 'グラフの対象データ範囲を指定 57 '.SetSourceData dataRng 58 59 Dim tmp As Variant, I As Long 60 tmp = .SeriesCollection(1).XValues 61 62 For I = 1 To UBound(tmp) 63 If InStr(tmp(I), "Product 10") > 0 Then 64 With .SeriesCollection(1).Points(I) 65 .Interior.ColorIndex = 3 66 .ApplyDataLabels 67 End With 68 End If 69 Next 70 71 'グラフタイトルを非表示 72 .HasTitle = False 73 74 'グラフのフォントを"Meiryo UI"、フォントサイズを"10"にする 75 With .ChartArea.Format.TextFrame2.TextRange.Font 76 .Size = 10 77 .NameComplexScript = "Meiryo UI" 78 .NameFarEast = "Meiryo UI" 79 .Name = "Meiryo UI" 80 End With 81 82 'グラフの貼り付け位置を指定 83 .Parent.Top = pasteRng.Top 84 .Parent.Left = pasteRng.Left 85 86 End With 87 88End Function

投稿2020/06/30 01:12

tosi

総合スコア553

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

izuki_y

2020/07/03 15:28

返信が遅くなって申し訳ございません。 内容をコピペさせて頂き期待に沿う形になった事を確認いたしました。 関数化して引数で汎用性を持たせる例を教えて頂きありがとうございます。 ものすごく参考になりました。 ベストアンサーにさせてください。
guest

0

ベストアンサーを選んだ上で
解決方法を書いたらどうなるんだろうか?

せっかく答えて頂いたベストアンサーが消えたりしないよね?

ベストアンサーが取り消されたらごめん。
テスト的に書いてみます。

投稿2020/07/03 15:39

izuki_y

総合スコア65

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問