人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

画像のようなグラフを Excel で作成しようと考えています。

http://www.geocities.jp/doves_flyin/1.jpg

与えられる数字は「1」「2」「3」「5」で、「1」「1+2-3」「5」「5-4」は負の値となる可能性があります。
全て正の値の場合、また、いくつかが負の値になる場合についてはうまく表示できたのですが、
自力ではどうしても全てのパターンを網羅することができませんでした。
なんとかなるものなのでしょうか。

ドンピシャの場合【1,000ポイント】でお願いします。

●質問者: ショウジ
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:Excel グラフ ドン パターン ポイント
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● tkr3a
●100ポイント

グラフになっている項目は以下の六つ

?、?、?、?、?-?、?

そのうち、負の値が許されるのは

?、 ?、?ー?、?

の四つだから、パターンは 2x2x2x2=16通り

ただし、

?>0、?-?>0、?<0

のパターンと

?<0、?-?<0、?>0

のパターンは論理的に有り得ないので、

?の正負2パターンを考慮して、16-2x2=12通りが有り得るパターンとなります。

以上をふまえて、全パターンは以下の通りです。

?、?、?ー?、?それぞれの符号:?、?、?、?それぞれの値

  1. :1,1,1,2
  2. :-1,3,1,2
  3. :1,1,3,1
  4. :-1,1,1,1
  5. :有り得ないパターン
  6. :有り得ないパターン
  7. :1,1,4,-1
  8. :-1,2,3,-1
  9. :2,2,2,1
  10. :-1,4,1,1
  11. :有り得ないパターン
  12. :有り得ないパターン
  13. :1,1,1,-1
  14. :-1,3,1,-1
  15. :1,1,3,-2
  16. :-1,2,2,-2

で、それぞれの値が0の場合は考慮しなくてよいのでしょうか?

(正の値としている?)

また、?が翌月の?となるのは不自然かと…

(?が翌月の?となるのでは?)

◎質問者からの返答

どうもありがとうございます。数学が苦手なのでパターンを列挙していただけただけでも非常に助かります。

なお、場合わけに際し0の場合は特に考慮していただかなくても構いません(考慮しないとグラフが作れない! のなら話は別ですが)。ただこれ全部盛り込んでグラフを作成できるのでしょうか……。

また、「不自然」なのは確かにその通りなのですが、「グラフではあえてそう見せたい」だけの話ですので、この点はお気になさらないでください。


2 ● Mook
●200ポイント

標準のグラフでは難しそうな気がしたので、マクロでの実現例です。

内容を勘違いしていたら、すみません。


まず、先頭のシートに下記の表を作成します。

A B C
1 グラフの最大値 500
2 グラフの最小値 0
3 グラフタイトル 4月
4 前月の残り 100 前月の残り
5 収入 300 収入
6 支払い 200 支払い
7 3列目のタイトル 残り
8 4列目のタイトル 目標との差
9 目標 400 目標

データ中の赤い文字が、グラフに使われるデータですので、この部分を実際のデータにあわせます。

すべてのデータの表示範囲が、「グラフの最大値」と「グラフの最小値」の間に入るように、最大値と最小値を設定してください。


次に下記のマクロを実行すると、2枚目のシートにグラフを作成します。

マクロはの実行は次の手順です。

(1)Alt+F11 を押し、

(2)「挿入」⇒「標準モジュール」で表示されたウィンドウに

(3)下記のコードを貼り付けます。

(4)次にExcelに戻って Alt+F8 を押し

(5)DrawGraph をクリックします

(2回目以降は(4)、(5)のみ)

'-----------------------------------------
' データセルの指定
'-----------------------------------------
Const GraphMax = "B1" '-- グラフの最大値
Const GraphMin = "B2" '-- グラフの最小値(0?)
Const GraphTitle = "B3" '-- グラフのタイトル
'-----------------------------------------
Const DataRest = "B4"
Const DataIn = "B5"
Const DataOut = "B6"
Const DataTitle3 = "B7"
Const DataTitle4 = "B8"
Const DataGoal = "B9"


'-----------------------------------------
' グラフの大きさの規定
'-----------------------------------------
Const StartX = 50
Const StartY = 100
Const GraphWidth = 300
Const GraphHeight = 200

Const SpaceX1 = 40
Const SpaceY1 = 20
Const SpaceX2 = 20
Const SpaceY2 = 40


'-----------------------------------------
' データの大きさの規定
'-----------------------------------------
Const DataWidth = 50
Const DataSpace = 8

'-----------------------------------------
' 描画用の大域データ
'-----------------------------------------
Public g_min As Double
Public g_max As Double

'------------------------------------------
' グラフを描画する関数
'------------------------------------------
Sub DrawGraph()
'------------------------------------------
 Dim d1 As Double
 Dim d2 As Double
 Dim d3 As Double
 Dim d4 As Double

 Dim gMin As Double
 Dim gmax As Double
 
 Worksheets(1).Select
 
 d1 = Range(DataRest).Value
 d2 = d1 + Range(DataIn).Value
 d3 = d2 - Range(DataOut).Value
 d4 = Range(DataGoal).Value

 If Range(GraphMin).Value > WorksheetFunction.Min(0, d1, d2, d3, d4) Then
 MsgBox "グラフの下限を超えているデータがあります。"
 Exit Sub
 End If
 If Range(GraphMax).Value < WorksheetFunction.Max(0, d1, d2, d3, d4) Then
 MsgBox "グラフの上限を超えているデータがあります。"
 Exit Sub
 End If
 
 DrawSheet Range(GraphMin).Value, Range(GraphMax).Value
 DrawData 1, 0, d1, Range(DataRest).Offset(0, 1).Value, RGB(0, 255, 0)
 DrawData 1, d1, d2, Range(DataIn).Offset(0, 1).Value, RGB(200, 240, 200)
 DrawData 2, d2, d3, Range(DataOut).Offset(0, 1).Value, RGB(200, 240, 200)
 DrawData 3, 0, d3, Range(DataTitle3).Offset(0, 1).Value, RGB(100, 100, 255)
 DrawData 4, d3, d4, Range(DataTitle4).Offset(0, 1).Value, RGB(150, 150, 255)
 DrawData 5, 0, d4, Range(DataGoal).Offset(0, 1).Value, RGB(0, 255, 0)
 DrawTitle Range(GraphTitle).Value

' --- グラフをグループ化
 Dim sp As Shape
 Dim spName() As Variant
 Dim i As Integer
 i = 0
 For Each sp In ActiveSheet.Shapes
 ReDim Preserve spName(i)
 spName(i) = sp.Name
 i = i + 1
 Next
 ActiveSheet.Shapes.Range(spName).Select
 Selection.ShapeRange.Group.Select

' --- 2シート目にコピー
 Selection.Copy
 Selection.Cut
 Worksheets(2).Select
 ActiveSheet.Paste
End Sub

'------------------------------------------
' グラフ用のシートを作成
'------------------------------------------
Sub DrawSheet(minNum#, maxNum#)
'------------------------------------------
 Dim sx As Double
 Dim sy As Double
 Dim ex As Double
 Dim ey As Double
 
 sx = StartX + SpaceX1
 sy = StartY + SpaceY1
 ex = sx + GraphWidth
 ey = sy + GraphHeight
 
 g_min = minNum
 g_max = maxNum
 With ActiveSheet.Shapes
' --- グラフシート
 .AddShape msoShapeRectangle, StartX, StartY, _
 GraphWidth + SpaceX1 + SpaceX2, GraphHeight + SpaceY1 + SpaceY2
' --- X軸
 Dim zeroY As Double
 If minNum < 0 And maxNum > 0 Then
 zeroY = maxNum / (maxNum - minNum) * GraphHeight
 .AddLine sx, StartY + SpaceY1 + zeroY, ex, StartY + SpaceY1 + zeroY
 drawScale g_max
 drawScale 0#
 drawScale g_min
 Else
 .AddLine sx, ey, ex, ey
 drawScale g_max
 drawScale g_min
 End If
' --- Y 軸
 .AddLine sx, sy, sx, ey
 End With
End Sub

'------------------------------------------
Sub drawScale(scaleVal#)
'------------------------------------------
 If scaleVal# > g_max Or scaleVal# < g_min Then
 Exit Sub
 End If
 
 Dim scaleNum As Double
 scaleNum = GraphHeight * (1 - (scaleVal - g_min) / (g_max - g_min))
 
 With ActiveSheet.Shapes
 .AddLine StartX + SpaceX1 - 5, StartY + SpaceY1 + scaleNum, _
 StartX + SpaceX1, StartY + SpaceY1 + scaleNum
 .AddTextbox(msoTextOrientationHorizontal, _
 StartX + 3, StartY + SpaceY1 - 7 + scaleNum, SpaceX1 - 10, 14).Select
 With Selection
 .Characters.Text = CStr(scaleVal)
 .Font.Name = "MS Pゴシック"
 .Font.FontStyle = "標準"
 .Font.Size = 9
 .HorizontalAlignment = xlRight
 .ShapeRange.Fill.Visible = msoFalse
 .ShapeRange.Line.Visible = msoFalse
 End With
 End With
End Sub

'------------------------------------------
Sub DrawData(pos%, startVal#, endVal#, title$, cl&)
'------------------------------------------
 Dim sx As Double
 Dim sy As Double
 Dim ex As Double
 Dim ey As Double

 sx = StartX + SpaceX1 + (pos - 1) * (DataWidth + DataSpace) + DataSpace
 ex = sx + DataWidth
 sy = StartY + SpaceY1 + GraphHeight * (1 - (startVal# - g_min) / (g_max - g_min))
 ey = StartY + SpaceY1 + GraphHeight * (1 - (endVal# - g_min) / (g_max - g_min))
 
 With ActiveSheet.Shapes
 .AddShape(msoShapeRectangle, sx, _
 WorksheetFunction.Min(sy, ey), DataWidth, Abs(sy - ey)).Select
 With Selection.ShapeRange
 .Fill.Visible = msoTrue
 .Fill.ForeColor.RGB = cl
 .Line.Weight = 1
 .Line.Style = msoLineSingle
 .Line.Visible = msoTrue
 .Line.ForeColor.SchemeColor = 0
 End With
 .AddTextbox(msoTextOrientationHorizontal, _
 sx, (sy + ey) / 2 - 7, DataWidth, 14).Select
 With Selection
 .Characters.Text = title
 .Font.Name = "MS Pゴシック"
 .Font.FontStyle = "標準"
 .Font.Size = 9
 .HorizontalAlignment = xlCenter
 .ShapeRange.Fill.Visible = msoFalse
 .ShapeRange.Line.Visible = msoFalse
 End With
 End With
End Sub

'------------------------------------------
Sub DrawTitle(title$)
'------------------------------------------
 Dim sx As Double
 Dim sy As Double
 Dim ww As Double
 Dim hh As Double
 
 sx = StartX + SpaceX1 + DataSpace
 sy = StartY + SpaceY1 + GraphHeight + SpaceY2 * 0.1
 ww = (DataWidth + DataSpace) * 5 - DataSpace
 hh = SpaceY2 * 0.6
 
 With ActiveSheet.Shapes
 .AddTextbox(msoTextOrientationHorizontal, _
 sx, sy, ww, hh).Select
 With Selection
 .Characters.Text = title
 .Font.Name = "MS Pゴシック"
 .Font.FontStyle = "標準"
 .Font.Size = 16
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
 .ShapeRange.Fill.Visible = msoFalse
 .ShapeRange.Line.Visible = msoTrue
 End With
 End With
End Sub

3 ● Mook
●200ポイント

コメントを有効にしていただければ助かるのですが、一点訂正です。

マクロの、3列、4列の描画部分を下記に変更してください。

 DrawData 3, 0, d3, Range(DataTitle3).Value, RGB(100, 100, 255)
 DrawData 4, d3, d4, Range(DataTitle4).Value, RGB(150, 150, 255)

DrawGraph の(空白行は入れないで)23行目あたりです。

◎質問者からの返答

どうもありがとうございました。

ちょっと研究してみます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ