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


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

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

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

回答の条件
  • 1人3回まで
  • 登録:2007/04/05 18:01:07
  • 終了:2007/04/09 11:57:35

回答(3件)

id:tkr3a No.1

tkr3a回答回数11ベストアンサー獲得回数02007/04/06 00:17:42

ポイント100pt

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

 ①、②、③、④、⑤-④、⑤

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

 ①、    ④、⑤ー④、⑤

の四つだから、パターンは 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の場合は考慮しなくてよいのでしょうか?

(正の値としている?)

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

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

id:maikuhama

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

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

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

2007/04/06 10:08:04
id:Mook No.2

Mook回答回数1313ベストアンサー獲得回数3922007/04/08 02:45:36

ポイント200pt

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

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


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

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
id:Mook No.3

Mook回答回数1313ベストアンサー獲得回数3922007/04/08 11:03:52

ポイント200pt

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

マクロの、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行目あたりです。

id:maikuhama

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

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

2007/04/09 11:56:41

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません