[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『関数か何かで柱状図のように縦向きにグラフのような罫線を書きたい』(もも)
標尺(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 >
1セルが1でないと不可能では?
(マナ) 2018/03/17(土) 19:53
N値が、前回のだと最大値が25で 横へ 0、10、20、30 と4つのセルで
表現したいのです。
(もも) 2018/03/17(土) 20:01
(マナ) 2018/03/17(土) 20:12
関数ではできません。
グラフでできるかもしれませんが、行間をあわせるのが難しいかも。
なので、マクロがよいかもしれません。
過去ログさがせばでてくると思います。
近いところでは、確か???さんが書いてたような気がします。
(マナ) 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
でした。
(マナ) 2018/03/17(土) 23:22
ありがとうございました!
一瞬で、やりたかったことが解決しました。
次回からは、自分で考えて不明点を質問出来るよう
しっかり勉強していこうと思います!!
(もも) 2018/03/17(土) 23:34
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
(マナ) 2018/03/18(日) 12:36
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
変数名が直観的にわかりにくいので、
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
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
>スタートの「0」のとこは
というのは、縦軸は、どの位置ですか?
>ほぼ出来たのですが・・・
>開始X = Cells(18, 3).Left + W
3行目のポイントの横位置(最初の開始X)が間違っていませんか。
>For i = 3 To 17
なぜ、3行目からですか。
(マナ) 2018/03/18(日) 19:49
>If Cells(i + 1, 2) <> "" Then
途中で、N値が空欄になることがあるのでしょうか
空欄の場合、プロットはしないのですか
(マナ) 2018/03/18(日) 19:58
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
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
のだから、
開始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.