[[20161207152200]]　『縦軸：利益率、横軸：売上の面積グラフ作成方法』（littecub_703）　ページの最後に飛ぶ

『縦軸：利益率、横軸：売上の面積グラフ作成方法』（littecub_703）

縦軸：利益率、横軸：売上の面積グラフは
Excelで作成可能でしょうか。
いくつかの事業のデータを置いて、
直感的にどの事業が多く利益を出しているかを
わかるようにしたいと考えています。

可能な場合、その作成方法をご教授いただければ幸いです。

不可能or作成方法が判明しない場合、
有料でも構いませんので、
そのようなグラフを作成可能なソフトをご存知でしたら
そちらについてご教授いただければと思います。

以上、宜しくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

複合グラフの事？
https://love-guava.com/excel-bar-graph-line-graph/

それとも
散布図にしたいのかな
https://software.ssri.co.jp/statweb2/tips/tips_6.html

ご参考に
（１１） 2016/12/07(水) 15:32

バブルチャートと呼ばれているんじゃなかったですかね。
ネット検索してみてください。

（γ） 2016/12/07(水) 16:35

γ様
バブルチャートね

円の大きさが面積か
すごい洞察力

ぴんと来なかった
暇だったからなにげに考えてたんだけど
（１１） 2016/12/07(水) 16:42

１１様、γ様
ご回答ありがとうございます。
複合グラフ、散布図、バブルチャート、いずれとも異なるものになります。

技量不足のため掲示板で再現するのが難しいのですが
下記で上手く伝わりますでしょうか。

利　-----
益　|AAAA|
率 |AAAA|----------
軸 |AAAA|BBBBBBBBBB|
　　------------------------------売上軸

 　   　            |    |
   　   　          | C  |
     　   　        |____|

このようなグラフをイメージしており、
例えば
A事業は売上そこそこで利益率が高いので利益額（面積）が大きい
Bは売上は大きいものの、利益率が低く利益額はそれほどでもない
Cは売上はそこそこだが、大きく赤字になっている
といったことが、直感的にわかればと考えています。
（littecub_703） 2016/12/07(水) 16:55

じゃーこんな感じ？？？

http://www.nikkeibp.co.jp/article/nba/20100331/218614/?P=1

面積グラフ　　エクセルで　　出てくると思いますよ
（１１） 2016/12/07(水) 17:23

事業数が幾つなのかによりますが、シェイプの四角形を使って表現してみてはいかがでしょうか？

縦軸は利益率の最大と最小で高さが決まり、横軸は売上合計で幅が決まるでしょう。個々のデータから割合を求め座標計算すれば良さそう。
コーディングするのは面倒だし、元データが判らないとさっぱりなので、コードは書きません。
事業数が少ないならば、手作業で図形の面積を操作して、レイアウトするだけで表現できそうです。
（???） 2016/12/07(水) 17:29

量率グラフ、とも呼ぶようですね。この程度の表現でもシェアウェアになっていたりしているようですが、手作りで角丸四角形にして、グラデ塗りとか使って綺麗に描いた方が良いように思いました。
（???） 2016/12/07(水) 17:42

１１様、？？？様

量率グラフにかなり近いものになりますが、
赤字の事業もあるため、試してみたシェアウェアでは
なかなかうまく描けません。。。

やはり手作業で図形を並べるしかないでしょうか。

このようなグラフを作成できる市販ソフトがあれば、とも
思うのですが、なかなかありませんかね。
別途開発するよりは安く済むと考えているのですが。
（littecub_703） 2016/12/07(水) 18:29

バブルチャートについては、
http://www.stat.go.jp/koukou/howto/process/graph/graph7.htm
を参考にして下さい。（総務省統計局作成のページです）
　
散布図と同様に、
・横軸に売上
・縦軸に対売上高利益率
を意識した場所に配置することで、
売上、利益率の水準を可視化できます。
そして、バブルの大きさで利益額の大きさを直感的に示せます。
　
利益がマイナスになることも考慮して、こういうケースには、
「負のバブルを表示する」
という選択肢も用意されています。
　
利益の大きさを四角形にするのは、私的にはマストの事項とは思えません。
　
何事にも"標準"的な手法というものがあります。
こういう量的な大きさを直感的に表示する手法があるのですから、
手作りのグラフと言わず、こうした標準を使うことを推奨します。
そのほうが手間も掛からずよろしいかと思いますよ。
　

（γ） 2016/12/07(水) 20:30

日付軸の面つかいます。
http://fast-uploader.com/file/7036665769331/

（水上） 2016/12/07(水) 20:37

量率グラフでは、縦と横の2つの要素しか表現できませんが、バブルを応用すると、縦と横と面積という3つの表現ができるので、ウチではよく使われますね。自動化せず、手作りですが。

とりあえず、元データのレイアウトが判らないので、以下と仮定したマクロ例を書きます。

	A	B	C
1	事業	売上	利益率
2	A	40	30%
3	B	100	10%
4	C	10	-10%

例えば、E:S列のセル幅2にしておいてください。セルの大きさに合わせて罫線を引きますので、これが目盛線になります。
上下左右に空間を空けずに描いたので、余白を作りたい場合は、コード中の罫線描画部分を消し、手作業で罫線を引いておくと良いでしょう。

 Sub test()
    Dim S As Shape
    Dim i As Long
    Dim iMax As Long
    Dim iUriW As Single
    Dim iRiekiU As Single
    Dim iRiekiH As Single
    Dim iTop As Single
    Dim iLeft As Single
    Dim iWidth As Single
    Dim iHeight As Single

    For Each S In Shapes
        If S.Type = msoAutoShape Then
            S.Delete
        End If
    Next S

    iMax = Cells(Rows.Count, "A").End(xlUp).Row
    With WorksheetFunction
        iUriW = .Sum(Range("B2:B" & iMax))
        iRiekiU = .Min(Range("C2:C" & iMax))
        iRiekiH = .Max(Range("C2:C" & iMax)) - .Min(iRiekiU, 0)
    End With

    With Range("E2:S9")
        With .Borders
            .LineStyle = xlContinuous
            .Color = RGB(128, 128, 128)
            .Weight = 2
        End With
        .Borders(xlInsideVertical).LineStyle = xlDot
        .Borders(xlInsideHorizontal).LineStyle = xlDot

        iLeft = .Left
        For i = 2 To iMax
            iWidth = .Width * Cells(i, "B").Value / iUriW
            iHeight = .Height * Abs(Cells(i, "C").Value) / iRiekiH
            If Cells(i, "C").Value < 0 Then
                iTop = .Top + .Height - iHeight
            Else
                iTop = .Top + .Height - iHeight + .Height * iRiekiU / iRiekiH
            End If
            Call sShapeAdd(iLeft, iTop, iWidth, iHeight, _
                (Array(RGB(0, 0, 0), RGB(0, 0, 0), RGB(0, 0, 0))(i - 2)), _
                (Array(RGB(0, 0, 255), RGB(0, 255, 0), RGB(255, 0, 0))(i - 2)), _
                (Array(RGB(0, 0, 128), RGB(0, 128, 0), RGB(128, 0, 0))(i - 2)), _
                (Array(RGB(0, 0, 32), RGB(0, 32, 0), RGB(32, 0, 0))(i - 2)))
            iLeft = iLeft + iWidth
        Next i
    End With
 End Sub

 Sub sShapeAdd(iLeft As Single, iTop As Single, iWidth As Single, iHeight As Single, iRGB0 As Long, iRGB1 As Long, iRGB2 As Long, iRGB3 As Long)
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, iLeft, iTop, iWidth, iHeight)
        With .Fill
            .ForeColor.RGB = iRGB0
            .OneColorGradient msoGradientHorizontal, 1, 1
            With .GradientStops
                .Insert 0, 0
                .Item(1).Color.RGB = iRGB1
                .Item(2).Color.RGB = iRGB2
                .Item(3).Color.RGB = iRGB3
                .Item(1).Position = 0.3
                .Item(2).Position = 0.5
                .Item(3).Position = 0.8
            End With
            .GradientAngle = 0
        End With
        With .Line
            .Weight = 1
            .ForeColor.RGB = RGB(0, 0, 0)
        End With
    End With
 End Sub
（???） 2016/12/08(木) 11:29

γ様

バブルチャートのご提案ありがとうございます。
確かに標準的な手法の方がなにかと良いですよね。

ただし、今回に限っては
上記のような四角形が横にならぶイメージでないと
いけない事情がありますので、
別の方法を検討したいと思います。

水上様

日付軸のご提案ありがとうございます。
手作業で図形を並べる方法もアリですが、
こちらのほうが綺麗に並べることが出来そうです。

???様

マクロまでありがとうございます！
こちら試してみてまたお返事させていただきます。
取り急ぎお礼まで。
（littecub_703） 2016/12/08(木) 11:47

???様

・記述いただいたものと同じ形でデータを入力
・記述いただいたマクロをコピペしてマクロ実行
といたしましたが、

「実行時エラー424　オブジェクトが必要です」と出ます。
「デバック」を押すと

    For Each S In Shapes
がハイライトされている状況です。

マクロ知識が皆無なので大変恐縮ですが、
対応方法ご教授いただけますでしょうか。

何卒宜しくお願いいたします。
（littecub_703） 2016/12/08(木) 12:02

標準モジュールにコードを貼りませんでしたか？シートモジュールに貼ってみてください。
（最終的に、ActiveXのボタンでも貼って使うだろう、という事を想定しています）
（???） 2016/12/08(木) 12:13

???様

シートモジュールに貼りなおしたところ、うまくいきました。
ありがとうございます！

どこをどう修正すると対象データ件数を増やせるのか、
オブジェクトの形や色を変更できるのか、
今後の為にも勉強しようと思います。

お忙しいところ、ありがとうございました！
（littecub_703） 2016/12/08(木) 12:53

元データ数は自動判定していますが、グラフの色数を有限にしています。
どうせなら、色も自動判定に変えてみましょうか。

先のデータに加えて、A列「事業」のセルを、それぞれ好きな色で塗りつぶしておいてください。
そして、マクロは以下のものに差し替えてください。

 Sub test()
    Dim S As Shape
    Dim i As Long
    Dim iMax As Long
    Dim iUriW As Single
    Dim iRiekiU As Single
    Dim iRiekiH As Single
    Dim iTop As Single
    Dim iLeft As Single
    Dim iWidth As Single
    Dim iHeight As Single

    For Each S In Shapes
        If S.Type = msoAutoShape Then
            S.Delete
        End If
    Next S

    iMax = Cells(Rows.Count, "A").End(xlUp).Row
    With WorksheetFunction
        iUriW = .Sum(Range("B2:B" & iMax))
        iRiekiU = .Min(Range("C2:C" & iMax))
        iRiekiH = .Max(Range("C2:C" & iMax)) - .Min(iRiekiU, 0)
    End With

    With Range("E2:S9")
        With .Borders
            .LineStyle = xlContinuous
            .Color = RGB(128, 128, 128)
            .Weight = 2
        End With
        .Borders(xlInsideVertical).LineStyle = xlDot
        .Borders(xlInsideHorizontal).LineStyle = xlDot

        iLeft = .Left
        For i = 2 To iMax
            iWidth = .Width * Cells(i, "B").Value / iUriW
            iHeight = .Height * Abs(Cells(i, "C").Value) / iRiekiH
            If Cells(i, "C").Value < 0 Then
                iTop = .Top + .Height - iHeight
            Else
                iTop = .Top + .Height - iHeight + .Height * iRiekiU / iRiekiH
            End If
            Call sShapeAdd(iLeft, iTop, iWidth, iHeight, Cells(i, "A").Interior.Color)
            iLeft = iLeft + iWidth
        Next i
    End With
 End Sub

 Sub sShapeAdd(iLeft As Single, iTop As Single, iWidth As Single, iHeight As Single, iRGB As Long)
    With ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, iLeft, iTop, iWidth, iHeight)
        With .Fill
            .ForeColor.RGB = RGB(0, 0, 0)
            .OneColorGradient msoGradientHorizontal, 1, 1
            With .GradientStops
                .Insert 0, 0
                .Item(1).Color.RGB = iRGB
                .Item(2).Color.RGB = (iRGB And &HFE0000) / 2 + (iRGB And &HFE00&) / 2 + (iRGB And &HFE&) / 2
                .Item(3).Color.RGB = (iRGB And &HFC0000) / 4 + (iRGB And &HFC00&) / 4 + (iRGB And &HFC&) / 4
                .Item(1).Position = 0.3
                .Item(2).Position = 0.5
                .Item(3).Position = 0.8
            End With
            .GradientAngle = 0
        End With
        With .Line
            .Weight = 1
            .ForeColor.RGB = RGB(0, 0, 0)
        End With
    End With
 End Sub
(14:06 RGB計算式を簡略化)
（???） 2016/12/08(木) 13:39

???様

すごい！ますます便利になりました！

こんなのがさらっと作れるなんて憧れます。

個人の趣味としては
・角ありの四角
・色は単色
にしたいと思いますので、
頑張ってマクロを編集してみます。

本当に助かりました。
ありがとうございました。
（littecub_703） 2016/12/08(木) 16:32

3色グラデなら2色で作成してから1色足すより、最初から3色作成でいいじゃん？、という突っ込みがどこからもこなかったので、そのままにしておくとして…。

msoShapeRoundedRectangle の部分が、角丸四角の指定になります。Roundedが付かないものが、普通の四角形です。
また、角丸のままで .Adjustments.Item(1) = 0.1 とか指定すると、丸の径が小さくなったりも可能。

単色で良いならば、OneColorGradientのあたりを変えて（消して）みてください。グラデ関係がごっそり消せるはず。（.Fill.ForeColor.RGB だけ指定で単色かな？単色は面積表現部分が大きいので、かなり寂しい感じになりますよ？）
どういう風に直すかは、マクロの自動記録を使って、手作業するのをマクロ化させれば、キーワードを知る事ができるでしょう。
（???） 2016/12/08(木) 17:42

質問者さま、是非教えてください。

バブルチャートでは、
・事業ごとの、売上、利益率などの他事業との比較は、
　散布図と同じですから、直感的にわかります。
・面積の大小は、円という相似形ですから直感的な比較が可能です。
　
＞ A事業は売上そこそこで利益率が高いので利益額（面積）が大きい
＞ Bは売上は大きいものの、利益率が低く利益額はそれほどでもない
＞ Cは売上はそこそこだが、大きく赤字になっている
＞といったことが、直感的にわかればと考えています。
というリクエストに応えていると思うのですが、いかがですか？
　
2016/12/07(水) 16:55 で示されたグラフで、
大きさの比較が直感的にできますか？
縦長だったり、正方形に近かったりするわけですが、
そうしたものの面積の大小比較があなたには直感的にできるのですか？
　
売上と利益率の要素は、横軸と縦軸とに
投影されているのですから、面積は単にその大きさだけが
わかればいいはずで、
面積を構成する2要素の内容は見なくてよいはずなんです。
　
(Q1)「2016/12/07(水) 16:55 で示されたグラフでなければ得られない視点」が
あり、バブルチャートにはそれが無いから使えない、ということですか？
だとしたら、それはいったいどんな視点なのですか？
(Q2)そして、そのことはあなたの質問事項に述べられていることなんですか？
後学のために是非教えてください。
(Q3)バブルチャートを実際に書いてみていますか？
どちらがわかりやすいかと、周囲の意見も聞いていますか？
　
思わず力が入ってしまったが、どうぞご教示くださいませ。
（γ） 2016/12/08(木) 21:21

バブルは件数が多いと裏に隠れて見えなくなる可能性があります。
利益の大きい順にならべることもできません。
面積グラフはそれも可能です。

（水上） 2016/12/09(金) 07:46

おもしろそうなコードなので使わせて頂いたが、利益率が全て黒字の時、困った描写になる。
（のぞき見） 2016/12/09(金) 10:38

のぞき見さん、ご指摘ありがとうございます。バグですね。
最初に全部プラスは試してあったのですが、途中からマイナス入りしか使わずに試していて、見落としました。

全マイナスもあり得るので、どう直すかちょっと考えてみます。
（???） 2016/12/09(金) 10:54

バグ修正版です。littecub_703さんが見てくれると良いのですが…。

 Sub test()
    Dim S As Shape
    Dim i As Long
    Dim iMax As Long
    Dim iUriW As Single
    Dim iRiekiU As Single
    Dim iRiekiH As Single
    Dim iTop As Single
    Dim iLeft As Single
    Dim iWidth As Single
    Dim iHeight As Single
    Dim iZero As Single

    For Each S In Shapes
        If S.Type = msoAutoShape Then
            S.Delete
        End If
    Next S

    iMax = Cells(Rows.Count, "A").End(xlUp).Row
    With WorksheetFunction
        iUriW = .Sum(Range("B2:B" & iMax))
        iRiekiU = .Min(Range("C2:C" & iMax))
        iRiekiH = .Max(.Max(Range("C2:C" & iMax)), 0) - .Min(iRiekiU, 0)
        iZero = .Max(0, -iRiekiU)
    End With

    With Range("E2:S9")
        With .Borders
            .LineStyle = xlContinuous
            .Color = RGB(128, 128, 128)
            .Weight = 2
        End With
        .Borders(xlInsideVertical).LineStyle = xlDot
        .Borders(xlInsideHorizontal).LineStyle = xlDot

        iZero = .Height * iZero / iRiekiH
        iLeft = .Left
        For i = 2 To iMax
            iWidth = .Width * Cells(i, "B").Value / iUriW
            iHeight = .Height * Abs(Cells(i, "C").Value) / iRiekiH
            iTop = .Top + .Height - iZero - IIf(Cells(i, "C").Value < 0, 0, iHeight)
            Call sShapeAdd(iLeft, iTop, iWidth, iHeight, Cells(i, "A").Interior.Color)
            iLeft = iLeft + iWidth
        Next i
    End With
 End Sub
（???） 2016/12/09(金) 11:32

コメント返信：

[ 一覧(最新更新順) ]

[[20161207152200]] 『縦軸：利益率、横軸：売上の面積グラフ作成方法』（littecub_703） ページの最後に飛ぶ

[[20161207152200]]　『縦軸：利益率、横軸：売上の面積グラフ作成方法』（littecub_703）　ページの最後に飛ぶ