[[20180317190106]] 『関数か何かで柱状図のように縦向きにグラフのよう』(もも) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『関数か何かで柱状図のように縦向きにグラフのような罫線を書きたい』(もも)

 標尺(m)	N値 | 0   10    20    30
 1	5   |                     ←この部分に、描きたい
 2	4    |                     
 3	2
 4	8
 5	3
 6	5
 7	10
 8	15
 9	20
 10	13
 11	20
 12	15
 13	18
 14	25
 15	5

このようなデータがあります。
これを、縦向きのグラフのように作成したいのです。
縦軸は、標尺(m)の目盛を使用し、N値が1セル「10」として
作成したいです。

このグラフ作成が、48枚分出てくるので(作成は来週から始まります)
始まる前に簡単に作成出来るようにしておきたいです。

ご教示お願い致します。

関数で、可能でしょうか?
今は、15mですが今回用がどれくらいまで出てくるかは月曜日に
ならないと分からないので修正対応出来るようにしておきたいです。

< 使用 Excel:Excel2013、使用 OS:Windows8 >


>N値が1セル「10」として

1セルが1でないと不可能では?

(マナ) 2018/03/17(土) 19:53


マナ様

N値が、前回のだと最大値が25で 横へ 0、10、20、30 と4つのセルで
表現したいのです。
(もも) 2018/03/17(土) 20:01


4セルだと、縦罫線は最大4本では?
セルの途中で罫線はだせません。

(マナ) 2018/03/17(土) 20:12


罫線じゃなくてオブジェクトの表現の間違いでした。
(もも) 2018/03/17(土) 20:21

>関数で、可能でしょうか?

関数ではできません。
グラフでできるかもしれませんが、行間をあわせるのが難しいかも。
なので、マクロがよいかもしれません。
過去ログさがせばでてくると思います。
近いところでは、確か???さんが書いてたような気がします。

(マナ) 2018/03/17(土) 20:34


マナ様

検索してみましたが分かりませんでした。

でも、マクロでやってみたいです。
(もも) 2018/03/17(土) 21:34


ごめんさい。
わたしも探せませんでした。
(確かあったはずなのですが)
 Option Explicit

 Sub test()
    Dim N値 As Range
    Dim n As Long
    Dim ff As FreeformBuilder
    Dim y As Double, x As Double
    Dim T As Double, L As Double
    Dim i As Long

    Set N値 = Range("B2" & Range("B2").End(xlDown))
    n = N値.Count

    y = N値.Height / n
    x = N値.Offset(, 1).Width / 10

    T = N値.Top - y / 2
    L = N値.Offset(, 1).Left

    Set ff = ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, _
                    L + N値(1).Value * x, T + y)

    For i = 2 To n
        ff.AddNodes msoSegmentLine, msoEditingAuto, _
                    L + N値(i).Value * x, T + i * y
    Next
    ff.ConvertToShape

 End Sub

(マナ) 2018/03/17(土) 22:35


マナ様

ありがとうございます。

 Next
    ff.ConvertToShape  ←ここで、黄色くなって止まってしまいます。

現在のデータは、

   A   B  C  D  E  F  
 1 標尺(m)  N値   0   10    20    30
 2  1
 3

 で、N値がB列に入っていてB列のデータの入っている最終列まで・・・
 と、読み取ったのでデータの場所とコードの辻褄はあっているような気は
 するのですが止まってしまう理由が解析できませんでした。
(もも) 2018/03/17(土) 23:10

>Set N値 = Range("B2" & Range("B2").End(xlDown))
  ↓
 Set N値 = Range("B2", Range("B2").End(xlDown))

でした。

(マナ) 2018/03/17(土) 23:22


マナ様

ありがとうございました!

一瞬で、やりたかったことが解決しました。

次回からは、自分で考えて不明点を質問出来るよう
しっかり勉強していこうと思います!!
(もも) 2018/03/17(土) 23:34


マナ様


Sub 柱状図作成()
 Dim i As Long, H As Single, StartL As Single, EndR As Single, TopL As Single, TopR As Single
 ActiveSheet.Shapes.SelectAll
 'Section.Deleteel
    For i = 3 To 18
        If Cells(2, i) <> "" Then
            StartL = Cells(2, i).Left
            TopL = Cells(3, i).Top + H - H * Cells(3, i + 1) / 0.1
            EndR = Cells(3, i + 1).Left
            TopR = Cells(3, i).Top + H - H * Cells(3, i) / 0.1
            With ActiveSheet.Shapes.AddLine(StartL, TopL, EndR, TopR).Line
                .ForeColor.RGB = vbBlue
                .Weight = 1
                .BeginArrowheadStyle = msoArrowheadOval
                .EndArrowheadStyle = msoArrowheadOval
            End With
        End If
    Next
 End Sub

いろんなのを参考に、書いてみたのですが●------●を書けるようにしてみたのですが
真横に

 ●-----●-----●-----●-----●-----● と、引かれて下に向かって書かれません。
 何が、違うんでしょうか?

(もも) 2018/03/18(日) 11:14


1)Cells(行, 列)です
2)変数Hは、行高さでしょうか
3)StartLを求める際にも、Hを使うと思います
4)EndRとTopRを求める際に、セル幅が必要ではありませんか

(マナ) 2018/03/18(日) 12:36


マナ様


Sub 柱状図作成()
 Dim i As Long, W As Single, StartL As Single, EndR As Single, TopL As Single, TopR As Single
 ActiveSheet.Shapes.SelectAll
 Selection.Delete
        W = 55
        StartL = Cells(18, 2).Left + W
            For i = 3 To 17
                If Cells(i, 2) <> "" Then
                    TopL = Cells(i, 2).Top
                    TopR = Cells(i + 1, 2).Top
                    If i <> 3 Then
                        StartL = EndR
                    End If
                        EndR = StartL + (Cells(i + 1, 2) - Cells(i, 2)) * 4.65
                        With ActiveSheet.Shapes.AddLine(StartL, TopL, EndR, TopR).Line
                            .ForeColor.RGB = vbRed
                            .Weight = 1
                            .BeginArrowheadStyle = msoArrowheadOval
                            .EndArrowheadStyle = msoArrowheadOval
                        End With
                    End If
            Next
 End Sub

ここから、オートシェイプをセルの真ん中に来るように少し下へ移動したいのですが
それに対してのコードがわかりません。
(もも) 2018/03/18(日) 14:52

>AddLine(StartL, TopL, EndR, TopR)

 変数名が直観的にわかりにくいので、

 StartL→開始X
 TopL→開始Y
 EndR→終了X
 TopR→終了Y

 として、説明します。

>W = 55

 Wは、Columns(3).Width/10で求めることができます

座標位置は、以下のように考えるとよいかもしれません。

 開始X:前回の終了X
 開始Y:前回の終了Y
 終了X:Columns(3)のLeftに、Cells(i+1,2)*Wを足す
 終了Y:Rows(i+1)のTopに、Rows(i+1)の高さ/2 を足す

(マナ) 2018/03/18(日) 15:40


マナ様
ほぼ出来たのですが・・・
スタートの「0」のとこは「B列」と「C列」の線の上に来てほしいのですが
少しずれてしまいます。

Sub 柱状図作成()
Dim i As Long
Dim W As Single
Dim 開始X As Single
Dim 開始Y As Single
Dim 終了X As Single
Dim 終了Y As Single

    ActiveSheet.Shapes.SelectAll
    Selection.Delete
    W = Columns(3).Width / 10 '55
    開始X = Cells(18, 3).Left + W
    For i = 3 To 17
        If Cells(i, 2) <> "" Then
            開始Y = Cells(i, 2).Top + Cells(i, 2).Height / 2
            終了Y = Rows(i + 1).Top + Rows(i + 1).Height / 2 'Cells(i + 1, 2).Top + Cells(i + 1, 2).Height / 2
        If i <> 3 Then
            開始X = 終了X
        End If
        終了X = Columns(3).Left + Cells(i + 1, 2) * W '開始X + (Cells(i + 1, 2) - Cells(i, 2)) * 4.6
            With ActiveSheet.Shapes.AddLine(開始X, 開始Y, 終了X, 終了Y).Line
                .ForeColor.RGB = vbRed
                .Weight = 1
                .BeginArrowheadStyle = msoArrowheadOval
                .EndArrowheadStyle = msoArrowheadOval
            End With
        End If
    Next
 End Sub

(もも) 2018/03/18(日) 19:27

ごめんなさい。よく理解できていません。

>スタートの「0」のとこは

というのは、縦軸は、どの位置ですか?

>ほぼ出来たのですが・・・
>開始X = Cells(18, 3).Left + W

3行目のポイントの横位置(最初の開始X)が間違っていませんか。

>For i = 3 To 17

なぜ、3行目からですか。

(マナ) 2018/03/18(日) 19:49


もう1つ確認です

>If Cells(i + 1, 2) <> "" Then

途中で、N値が空欄になることがあるのでしょうか
空欄の場合、プロットはしないのですか

(マナ) 2018/03/18(日) 19:58


 A   B  C  D  E  F   G
 1              N値
 2 標尺(m)  N値   0   10    20    30  40
 3  0 ← ここ追加しました。
 4 1

  空欄は、ありえません!
  データ数は、今と同じか少し増えるか減るかです。
(もも) 2018/03/18(日) 20:09

問題は、ここですね。

>開始X = Cells(18, 3).Left + W

あと、これは不要ですね。

>If Cells(i + 1, 2) <> "" Then

かわりに、↓の17をB列データ最終行にするとよいです。

>For i = 3 To 17

(マナ) 2018/03/18(日) 20:24



Sub 柱状図作成3()
 Dim i As Long
 Dim W As Single
 Dim 開始X As Single
 Dim 開始Y As Single
 Dim 終了X As Single
 Dim 終了Y As Single

        ActiveSheet.Shapes.SelectAll
        Selection.Delete
            W = Columns(3).Width / 10 '55
            開始X = Cells(3, 3).Left + W 'Cells(3, 3).Height / 2 'W
            For i = 3 To 17 'Cells(Rows.Count, 2).End(xlUp).Row
                'If Cells(i, 2) <> "" Then
                    開始Y = Cells(i, 2).Top + Cells(i, 2).Height / 2
                    終了Y = Rows(i + 1).Top + Rows(i + 1).Height / 2 'Cells(i + 1, 2).Top + Cells(i + 1, 2).Height / 2
                    If i <> 3 Then
                        '開始X = Cells(3, 2)
                        開始X = 終了X
                    End If
                    If i = 3 Then
                        開始X = Cells(3, 2)
                        '開始X = 終了X
                    End If

                        終了X = Columns(3).Left + Cells(i + 1, 2) * W '開始X + (Cells(i + 1, 2) - Cells(i, 2)) * 4.6
                            With ActiveSheet.Shapes.AddLine(開始X, 開始Y, 終了X, 終了Y).Line
                                .ForeColor.RGB = vbRed
                                .Weight = 1
                                .BeginArrowheadStyle = msoArrowheadOval
                                .EndArrowheadStyle = msoArrowheadOval
                            End With
                'End If
                Next
 End Sub

>For i = 3 To 17
 ↓
For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
に、すると19行目までプロットされてしまいます。

また、「A3」に「0」がプロットされて「C4」からはきちんとプロット出来ているのですが。

すいません。
答えを、教えてください。ギブアップです。

(もも) 2018/03/18(日) 21:46


>スタートの「0」のとこは「B列」と「C列」の線の上に来てほしい

のだから、

開始X = Columns(3).Left

ですね。

>開始X = Cells(18, 3).Left + W

「+ W 」が不要というか意味不明です。

'----

>For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
>に、すると19行目までプロットされてしまいます。

B列は数式ですか。
そうであれば、

>If Cells(i, 2) <> "" Then

だと、無駄に継続するので

If Cells(i, 2) = "" Then Exit For

で、ループを抜けるとよいです。

(マナ) 2018/03/18(日) 22:13


少し無駄もありますが
わかりやすさ優先だとこんな感じでできませんか。
 Option Explicit

 Sub test2()
    Dim i As Long
    Dim W As Single
    Dim 開始X As Single
    Dim 開始Y As Single
    Dim 終了X As Single
    Dim 終了Y As Single

    ActiveSheet.Shapes.SelectAll
    Selection.Delete

    W = Columns(3).Width / 10

    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        If Cells(i, 2).Value = "" Then Exit For

        開始X = Columns(3).Left + Cells(i, 2).Value * W
        開始Y = Rows(i).Top + Rows(i).Height / 2

        終了X = Columns(3).Left + Cells(i + 1, 2).Value * W
        終了Y = Rows(i + 1).Top + Rows(i + 1).Height / 2

        With ActiveSheet.Shapes.AddLine(開始X, 開始Y, 終了X, 終了Y).Line
            .ForeColor.RGB = vbRed
            .Weight = 1
            .BeginArrowheadStyle = msoArrowheadOval
            .EndArrowheadStyle = msoArrowheadOval
        End With
    Next

 End Sub

(マナ) 2018/03/18(日) 23:11


マナ様

ありがとうございます!!

でも、やっぱり19行目までプロットされてしまいます・・・

B列は、数式ではなく数値で入ってます。
(もも) 2018/03/19(月) 05:27


もしかして、こういうことですか。

>If Cells(i, 2).Value = "" Then Exit For

↑は削除

>For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
は、以下に修正↓
 For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row -1

(マナ) 2018/03/19(月) 13:04


遅ればせながら、横入り。

柱状図でしょ?
グラフで書けばよくないですか?
折れ線グラフ、縦方向にできませんでしたっけ?

(まっつわん) 2018/03/21(水) 07:37


他人からもらった資料に柱状図が縦にグラフ作ってあるから普通に出来ますね。

あと、も少し便利な機能もエクセルにはあった気がするからも少し調べてみます。

(まっつわん) 2018/03/21(水) 07:45


う〜ん。

データーバーやスパークラインでなんとかならないかと思いましたがダメっぽいですね。

でーたを横に配置して文字を90°回転させてスパークライン表示させて、
図としてリンク貼り付けして回転させればそれっぽくなりますが、
ちょっとセルと位置関係がずれますねー。

グラフを普通に書いたらいいと思います。
訳のわからんマクロ使っても、ちょっとの変更で躓くようじゃぁ、
使わない方が気分的に楽だと思います。
(まっつわん) 2018/03/21(水) 08:09


 Option Explicit

Sub test003()

    Dim rngData As Range
    Dim rngGraph As Range
    Dim rngLast As Range
    Dim c As Range
    Dim X1 As Double
    Dim Y1 As Double
    Dim X2 As Double
    Dim Y2 As Double
    Dim Gmax As Double
    Dim n As Long

    ActiveSheet.Shapes.SelectAll
    Selection.Delete

    Set rngData = Range("A1").CurrentRegion.Offset(1).Cells
    Set rngGraph = rngData.Resize(, 5).Offset(, rngData.Columns.Count + 1).Cells
    Set rngLast = rngData(1, 2).Cells
    Let Gmax = rngGraph.Width

    For Each c In rngData.Columns(2).Offset(1).Cells
        If Not IsEmpty(c.Value) Then
            With rngLast
                n = IIf(.Value > 50, 50, .Value)
                With Intersect(.EntireRow, rngGraph.Columns(1)).Cells
                    X1 = .Left + Gmax / 50 * n
                    Y1 = .Top + .Height / 2
                End With
            End With
            With c
                n = IIf(.Value > 50, 50, .Value)
                With Intersect(.EntireRow, rngGraph.Columns(1)).Cells
                    X2 = .Left + Gmax / 50 * n
                    Y2 = .Top + .Height / 2
                End With
            End With
            With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Line
                .ForeColor.RGB = vbRed
                .Weight = 1
                .BeginArrowheadStyle = msoArrowheadOval
                .EndArrowheadStyle = msoArrowheadOval
            End With
            Set rngLast = c.Cells
        End If
    Next
End Sub

1)空白は無視(ただし1行目の空白はは0として扱う)で、書いてみました。
(絶対と言われるけど、データの欠落が無いようにと言われるプレッシャー負けてもいいように^^;
性格がどうしてもいい加減なので><コードも実務に影響がない程度にいい加減です。)
2)N値は最大が50みたいなのでそれに対応しました。

(まっつわん) 2018/03/21(水) 09:22


まっつわん様

返信遅くなりました。

明日、会社へ出社したら動作確認してみます。
(もも) 2018/03/22(木) 21:25


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.