| |
※エクセルの学校（[[20210622160511]]）とのマルチポスト投稿になります。ご了承ください
現在、下記の表（本来の表だと行数が多いのでイメージ）からVBAで複数のグラフを作ろうとしています。
[A] |[B] |[C] |[D] |[E] |[F]
[ 1]（大内訳1） | | | | |10000
[ 2] |Aさん |3000 |0.3 |〇100% |
[ 3] |Bさん |2000 |0.2 | |
[ 4] |Cさん |1000 |0.1 | |
[ 5] | |0 | | |
――――――――――――――――――――――――――――――――
[ 6] |Dさん |3000 |0.3 | |
[ 7] |Eさん |1000 |0.1 | |
[ 8] | |0 | | |
――――――――――――――――――――――――――――――――
[ 9]（大内訳2） | | | | |
[10] |Fさん |
・
・
・
A・B・FとC・D・Eはそれぞれ別シートからコピーしたもので、C行には計算式（C3なら=F2*D3）、EにはD列の大内訳1つごとにF行と比較して数値が100%一致するかをif関数（=IF(SUM(D3:D8)=1,"〇 "&SUM(D3:D8)*100&"%","× "&SUM(D3:D8)*100&"%")）で見ています。
またA・B・Fをコピーしたシートは本来2〜8行目の部分は存在せず、コピーしてから空白行を行数決め打ちで増やしています。
ここから現在、大内訳の全体（1〜8行目）を円グラフ、大内訳を更に区分けしたもの（小内訳A（1〜5列目）と小内訳B（6〜8行目））を100%積み上げ横棒で作成しています。
大内訳は毎回変わりますが大体10個程度と決め打ちしました。
ここからが問題になりますが、小内訳の中の人数も毎回変動があり、どうしても空白行ができてしまいます。
そして空白行ができてしまうと分類名のデータラベルがうまく出てくれません。
空白行を削除しようとしても、グラフの範囲自体も決め打ちで作成してしまったためグラフ範囲がずれてしまいます。
このVBAを作った後、グラフ作成に慣れていない人に渡す必要があるので手動での修正が行えません。
現在の運用方法は
1 別のマクロでA・B・FとC・D・Eにそれぞれ別のシートから列を貼り付けて3行目〜19行目（イメージで言う2行目〜8行目）の空白行を増やす。以降の大内訳も同様に17行ごと増やす
2 3行目〜19行目のB列に名前、D列に数値の比率を手入力
3 今回提示したマクロを使ってグラフを3種類作る
と言った動きを考えています。
この時にBに空欄セルがある状態でグラフを出力するとB列の名前が出ず、データソースでも項目軸ラベルがなしになっています。
Bが全部埋まった状態だと項目軸ラベルでBが選択されるので、空欄があってもこの状態を目指したいです。
どなたかお力添えをお願いいたします。
以下、作成したvbaになります。
上のイメージ表と範囲行が違いますがご了承ください。
-----------------------
Sub グラフ作成()
Worksheets("グラフ用").Activate
'既にあるグラフを削除
Dim i As Long
With ActiveSheet
For i = .ChartObjects.Count To 1 Step -1
.ChartObjects(i).Delete
Next i
End With
'グラフ作成1---------------------------------------
With ActiveSheet.Shapes.AddChart.Chart
'ドーナツグラフ追加_凡例はグラフの上
.ChartType = xlDoughnut
.SetSourceData Range("b3:c19")
.SetElement (msoElementDataLabelCallout)
.HasLegend = False
End With
With ActiveSheet.Shapes.AddChart.Chart
'100% 積み上げ横棒グラフ追加
.ChartType = xlBarStacked100
.SetSourceData Range("b3:c12")
.ChartColor = 14
Select Case .PlotBy
Case xlRows
.PlotBy = xlColumns
Case xlColumns
.PlotBy = xlRows
End Select
End With
With ActiveSheet.Shapes.AddChart.Chart
'100% 積み上げ横棒グラフ追加
.ChartType = xlBarStacked100
.SetSourceData Range("b13:c19")
.ChartColor = 17
Select Case .PlotBy
Case xlRows
.PlotBy = xlColumns
Case xlColumns
.PlotBy = xlRows
End Select
End With
'グラフ作成2---------------------------------------
With ActiveSheet.Shapes.AddChart.Chart
'ドーナツグラフ追加
.ChartType = xlDoughnut
.SetSourceData Range("b21:c37")
.SetElement (msoElementDataLabelCallout)
.HasLegend = False
End With
With ActiveSheet.Shapes.AddChart.Chart
'100% 積み上げ横棒グラフ追加
.ChartType = xlBarStacked100
.SetSourceData Range("b21:c30")
.ChartColor = 14
Select Case .PlotBy
Case xlRows
.PlotBy = xlColumns
Case xlColumns
.PlotBy = xlRows
End Select
End With
With ActiveSheet.Shapes.AddChart.Chart
'100% 積み上げ横棒グラフ追加
.ChartType = xlBarStacked100
.SetSourceData Range("b31:c37")
.ChartColor = 17
Select Case .PlotBy
Case xlRows
.PlotBy = xlColumns
Case xlColumns
.PlotBy = xlRows
End Select
End With
（以下繰り返しなので割愛）
End Sub
|
|
sky
- 21/6/28(月) 9:55 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
