VBA100本ノック 37本目：グラフの色設定

公開日：2020-12-01　最終更新日：2021-02-22

VBA100本ノック 37本目：グラフの色設定

グラフの系列の一部のみ設定を変更する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 37本目
棒グラフの最大値と最小値を目立たせたい。
最大値を緑、最小値を赤、データラベルも追加。
データはB2開始で増減に対応し、再実行を考慮してください。
※グラフは棒グラフ作成済です。既定色は随意。
※出来上がりは添付を参照
※シートは任意、グラフはシートに1つだけ

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_37.xlsm
https://excel-ubara.com/vba100sample/VBA100_37.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

目的のグラフの特定要素にたどり着くには、かなり多くのオブジェクトを辿らなければなりません。
Worksheet
ChartObjects
Chart
SeriesCollection
Point
VBAでは、組み込みのオブジェクトを順に辿ることがしばしば要求されます。
マクロの記録、オブジェクトブラウザ、WEB検索を使って調べます。


  
    
      Sub VBA100_37_01()

　　Dim ws As Worksheet

　　Set ws = ActiveSheet

　　

　　Dim maxVal As Double, minVal As Double

　　Dim valRng As Range, rng As Range
　　Set valRng = ws.Range("B1").CurrentRegion

　　Set valRng = Intersect(valRng, valRng.Offset(1, 1))

　　maxVal = WorksheetFunction.Max(valRng)

　　minVal = WorksheetFunction.Min(valRng)

　　

　　Dim i As Long

　　With ws.ChartObjects(1).Chart.SeriesCollection(1)

　　　　.Interior.Color = RGB(68, 114, 196)

　　　　.ApplyDataLabels xlDataLabelsShowNone

　　　　For i = 1 To valRng.Count

　　　　　　Select Case valRng(i)

　　　　　　　　Case maxVal

　　　　　　　　　　.Points(i).Interior.Color = vbGreen

　　　　　　　　　　.Points(i).ApplyDataLabels

　　　　　　　　Case minVal

　　　　　　　　　　.Points(i).Interior.Color = vbRed

　　　　　　　　　　.Points(i).ApplyDataLabels

　　　　　　End Select

　　　　Next

　　End With

End Sub

このVBAはグラフの元データのセル範囲からグラフの位置を特定しています。
しかしグラフの中には元データの値が入っているので、この数値を参照することもできます。
また、色も枠線と内側の塗りつぶしを別々に指定することもできます。
これらについては記事補足にて。

補足

先のVBAでは、グラフの元データ範囲をループさせましたが、グラフの系列の中をループさせつつ値を見ていくこともできます。
色の塗り方も、枠線と中を別々の色で設定することができます。
また、データラベルの表示非表示は先のVBAはメソッドですが、プロパティもあります。


  
    
      Sub VBA100_37_02()

　　Dim ws As Worksheet

　　Set ws = ActiveSheet

　　

　　Dim maxVal As Double, minVal As Double

　　Dim valRng As Range, rng As Range

　　Set valRng = ws.Range("B1").CurrentRegion

　　Set valRng = Intersect(valRng, valRng.Offset(1, 1))

　　maxVal = WorksheetFunction.Max(valRng)

　　minVal = WorksheetFunction.Min(valRng)

　　

　　Dim i As Long, sr As Series

　　Set sr = ws.ChartObjects(1).Chart.SeriesCollection(1)

　　With ws.ChartObjects(1).Chart.SeriesCollection(1)

　　　　.Format.Line.Visible = msoFalse

　　　　.Interior.Color = RGB(68, 114, 196)

　　　　.ApplyDataLabels xlDataLabelsShowNone

　　　　.HasDataLabels = False

　　　　For i = 1 To .Points.Count

　　　　　　Select Case sr.Values(i)

　　　　　　　　Case maxVal

　　　　　　　　　　.Points(i).Format.Line.Visible = msoTrue

　　　　　　　　　　.Points(i).Format.Line.ForeColor.RGB = vbBlack

　　　　　　　　　　.Points(i).Format.Fill.ForeColor.RGB = vbGreen

　　　　　　　　　　.HasDataLabels = True

　　　　　　　　Case minVal

　　　　　　　　　　.Points(i).Format.Line.Visible = msoTrue

　　　　　　　　　　.Points(i).Format.Line.ForeColor.RGB = vbBlack

　　　　　　　　　　.Points(i).Format.Fill.ForeColor.RGB = vbRed

　　　　　　　　　　.HasDataLabels = True

　　　　　　End Select

　　　　Next

　　End With

End Sub

上記では、最大値・最小値をセル範囲から取得していますが、
SeriesCollection(1).Values
ここに値が配列で入っているので、最大値・最小値をここから取得すればVBAが簡潔になります。
この点を変更して、最初のVBAを変更してみます。


  
    
      Sub VBA100_37_03()

　　Dim ws As Worksheet

　　Set ws = ActiveSheet

　　

　　Dim maxVal As Double, minVal As Double

　　Dim i As Long, sr As Series

　　Set sr = ws.ChartObjects(1).Chart.SeriesCollection(1)

      　　With ws.ChartObjects(1).Chart.SeriesCollection(1)

　　　　maxVal = WorksheetFunction.Max(sr.Values)

　　　　minVal = WorksheetFunction.Min(sr.Values)

　　　　.Interior.Color = RGB(68, 114, 196)

　　　　.ApplyDataLabels xlDataLabelsShowNone

　　　　For i = 1 To .Points.Count

　　　　　　Select Case sr.Values(i)

　　　　　　　　Case maxVal

　　　　　　　　　　.Points(i).Interior.Color = vbGreen

　　　　　　　　　　.Points(i).ApplyDataLabels

　　　　　　　　Case minVal

　　　　　　　　　　.Points(i).Interior.Color = vbRed

　　　　　　　　　　.Points(i).ApplyDataLabels

　　　　　　End Select

　　　　Next

　　End With

End Sub

このVBAはセル範囲を使っていないので、元データの範囲に非表示行があったり、複雑な選択をしていても問題なく対応できます。

SeriesCollectionとFullSeriesCollectionの違いについて

マクロの記録ではFullSeriesCollectionで記録されたと思います。
> FullSeriesCollectionオブジェクトを使用すると、フィルターで除外された Series オブジェクトを取得したり、再び除外したりすることができます。
以下の公式ドキュメントに書かれています。

FullSeriesCollection オブジェクト (Excel)

これを読んでも良く分からないと思いますが、通常はどちらを使っても同じです。

ここで、系列のチェックを外したときに消した系列を、
含めるのがFullSeriesCollection
含めないのがSeriesCollection
この違いになります。

サイト内関連ページ

第96回．グラフ（Chart）｜VBA入門

・グラフ（Chart）関連のオブジェクト群・単純な棒グラフの作成・２軸グラフの作成と、グラフタイトルをA1セルにリンク・マクロVBAでのグラフの扱いについて

円グラフの色設定（Chart,SeriesCollection）

円グラフの色を、元の表から設定します。以下は、ウイザードでグラフを作成した状態です。A列に指定した、塗りつぶし色を、グラフに反映させます。たった、これだけです。手作業よりは、はるかに簡単ですし、応用範囲が広いと思います。

棒グラフ・折れ線グラフのサンプルマクロ

グラフはプロパティ・メソッドも多いので、自分の覚書もかねて掲載しました。この元データから、以下のグラフが作成されます。解説は、プログラム内のコメントを参考にして下さい。系列データのデータ数が増えた時に、データ範囲を変更するマクロも掲載しておきます。

人口ピラミッドのグラフをマクロで作成

人口ピラミッドのグラフ作成は、設定項目が多く、かなり面倒です。マクロでサクッと作って、細かい部分を手動で設定できれば楽です。この表から、以下のグラフを作成します。手動で設定すると、かなり多くの手順が必要になります。

グラフで特定の横軸の色を変更し基準線を引くマクロ

特定の横軸のみ色を変更する、つまり、基準値や下限・上限等に線を引きたい場合のマクロVBAになります。手動でやろえとすると結構面倒なので、いざやろうとするとなかなか出来なかったりします。グラフの元データに線を引きたい数値の系列をシートに追加しておくと、もう少し楽にできますが、ここでは、シートには手を加えずに基準線を引…

グラフのデータ範囲を自動拡張するマクロ

グラフのデータ範囲を自動で拡張・縮小するマクロVBAになります、グラフのデータ範囲を変更する事は度々ありますが、作業自体は大した事はないのですが、やはり面倒ですし、グラフの数が多いと、結構な手間になります。注意以下は、棒グラフ・折れ線グラフの場合になります。

同じテーマ「VBA100本ノック」の記事

34本目：配列の左右回転
 35本目：条件付き書式
 36本目：列の並べ替え
37本目：グラフの色設定
38本目：1シートを複数シートに振り分け
 39本目：数値リストの統合（マージ）
40本目：複数ブックの統合
 41本目：暗算練習アプリ
 42本目：データベース形式に変換
 43本目：CSV出力
 44本目：全テーブル一覧作成

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
37本目：グラフの色設定

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 37本目：グラフの色設定