[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『開始時間と終了時間の矢印を分単位で表示したい』（はら）
VBA初心者です。
1時間毎でしか矢印が作成されませんでした。
分単位で矢印の長さが変わるようにするにはどのようにしたら良いのでしょうか？
Sub ガントチャート描画2()
Dim c As Range Dim org As Range Dim dst As Range
For Each c In Range("D8:D20")
If c.Value <> "" Then
Call MyFind(c.Text, org)
Call MyFind(c.Offset(0, 1).Text, dst)
With ActiveSheet.Shapes.AddLine(org.Left + 0, _
c.Top + 7, dst.Left + 0, c.Top + 7).Line
.EndArrowheadStyle = msoArrowheadTriangle
.ForeColor.RGB = RGB(0, 0, 128)
.Weight = 3
End With
End If
Next
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
A B C D E F G H I J .. 1 2 3 4 5 8:00 9:00 10:00 11:00... 6 7 8 8:00 9:15 →→→ 9 10
F5〜1時間単位での時間セル
D8〜開始時間
E8〜終了時間
矢印を表示させたいのは、F8〜です
（はら） 2020/02/20(木) 10:25
想像すると、時間を元に1セル（Rangeオブジェクト）を返しているのでしょうか？ 1列の幅が1時間単位なら、1時間単位でしか描画できなくて当然かと思いますよ。 これを座標単位で返すように変更し、分まで含めて計算すれば良いかと。
例えば、1セルが1時間を示しているならば、60等分すれば1分ですよね。 セル幅*分/60 が、分単位のサイズになります。
（???） 2020/02/20(木) 10:41
Sub ガントチャート描画2()
Dim c As Range Dim org As Range Dim dst As Range
For Each c In Range("D8:D20")
If c.Value <> "" Then
Call MyFind(c.Text, org)
Call MyFind(c.Offset(0, 1).Text, dst)
With ActiveSheet.Shapes.AddLine(org.Left + 0, _
c.Top + 7, dst.Left + 0, c.Top + 7).Line
.EndArrowheadStyle = msoArrowheadTriangle
.ForeColor.RGB = RGB(0, 0, 128)
.Weight = 3
End With
End If
Next
End Sub
Private Sub MyFind(ByVal src As String, ByRef rng As Range)
Dim r As Range
Set rng = Nothing
For Each r In Range("F5:AJ5")
If r.Text = src Then
Set rng = r
Exit Sub
End If
Next
End Sub
（はら） 2020/02/20(木) 10:47
Sub ガントチャート描画2()
Dim c As Range
Dim org As Single
Dim dst As Single
For Each c In Range("D8:D20")
If c.Value <> "" Then
Call MyFind(c.Text, org)
Call MyFind(c.Offset(0, 1).Text, dst)
With ActiveSheet.Shapes.AddLine(org, c.Top + 7, dst, c.Top + 7).Line
.EndArrowheadStyle = msoArrowheadTriangle
.ForeColor.RGB = RGB(0, 0, 128)
.Weight = 3
End With
End If
Next
End Sub
Private Sub MyFind(src As String, rng As Single)
With Range("G5")
rng = .Left + .Width * (TimeValue(src) - TimeValue("8:00")) * 24
End With
End Sub
24倍にしたのは、Date型って1日24時間を1として、時分を小数点以下で表現しているので、1時間が1/24だからです。 分の差を取り出すより、時分の差を取り出す方が簡単だったので、考えを変えました。
（???） 2020/02/20(木) 11:26
追加になってしまうのですが、横軸の5からの時間は月から金までの24時間✖5日で、
縦軸のD.EはそれぞれD8:D50まであります。
24時を超える場合と縦にデータが並んでいる場合はどのようにしたら良いのでしょうか？
何度もすみません！
よろしくお願いしますm(_ _)m
（はら） 2020/02/20(木) 14:01
rng = .Left + .Width * (IIf(TimeValue(src) < TimeValue("8:00"), 1, 0) + TimeValue(src) - TimeValue("8:00")) * 24
縦がD20までではなくD50なのだとしたら、そういう文字列を書いてある箇所を書き換えるだけですよ。
（???） 2020/02/20(木) 14:15
そうなると、今のMyFindの考え方では駄目ですね。 始点と終点で1回ずつ呼ぶので、今は8時を基準にしているので、8時〜14時は誤判定してしまいます。 1回で両方の座標を得るように変えないとです。
直しついでに、テスト実行する度に矢印を削除するのが面倒になったので、自動削除する処理も入れてます。
Sub ガントチャート描画2()
Dim S As Shape
Dim c As Range
Dim org As Single
Dim dst As Single
For Each S In Shapes
If S.Name Like "矢印*" Then
S.Delete
End If
Next S
For Each c In Range("D8:D50")
If c.Value <> "" Then
Call MyFind(c.Text, c.Offset(0, 1).Text, org, dst)
With ActiveSheet.Shapes.AddLine(org, c.Top + 7, dst, c.Top + 7)
.Name = "矢印" & c.Row
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.ForeColor.RGB = RGB(0, 0, 128)
.Line.Weight = 3
End With
End If
Next
End Sub
Private Sub MyFind(cSt As String, cEd As String, iSt As Single, iEd As Single)
With Range("G5")
iSt = .Left + .Width * (TimeValue(cSt) - TimeValue("8:00")) * 24
iEd = .Left + .Width * (IIf(TimeValue(cEd) < TimeValue(cSt), 1, 0) + TimeValue(cEd) - TimeValue("8:00")) * 24
End With
End Sub
（???） 2020/02/20(木) 14:31
F5から横軸に 2020/2/17 8:00 2020/2/17 9:00...のように
西暦から時間までが入っています。
開始時間と終了時間のD5、E5も縦軸に同じく
2020/2/17 10:00 2020/2/1717:25
2020/2/18 3:00 2020/2/18/5:00
...
のようにデータが入っています。
ガントチャートのような分単位でのシフト表を作るのが理想なのですが、
どうでしょうか？
何度もすみませんがよろしくお願いしますm(_ _)m
（はら） 2020/02/20(木) 19:09
D列E列にも年月日が付いているならば、同じロジックでいけますよ。 ただし、TimeValueでは対応できないので、cDateとかDateDiffを使って書き直してみてください。
MsgBox "差は" & DateDiff("n", CDate("2020/2/20 23:00"), CDate("2020/2/21 01:00")) & "分"
（???） 2020/02/21(金) 09:38
With Range("G5")
iSt = .Left + .Width * (TimeValue(cSt) - TimeValue("8:00")) * 24
iEd = .Left + .Width * (IIf(TimeValue(cEd) < TimeValue(cSt), 1, 0) + TimeValue(cEd) - TimeValue("8:00")) * 24
End With
出来たらこの部分だけでも教えて頂けませんか？
よろしくお願いします(;_;)
（はら） 2020/02/21(金) 10:00
IIf文は要らなくなると思うし、最初にアドバイスした、分は1時間の1/60、という事を理解していれば、後は私の書いたヒントを応用できる事でしょう。
ロジックを言葉にすると、先頭日時との時間差（分）を計算する事で、先頭日時のセルとの座標差を計算。 先頭日時のLeft座標にこれを足すと、目的の座標が判る、という感じです。
（???） 2020/02/21(金) 10:39
VBAに関してほとんど無知なので/60をどこに
入れれば良いかわからないです(;_;)
出来たらコードを教えてもらえないでしょうか？
IIfは要らないというのはiEdから全ていらないのでしょうか？
すみませんが教えていただけると助かります(;_;)
（はら） 2020/02/21(金) 12:05
Sub ガントチャート描画2()
Dim S As Shape
Dim R As Range
Dim iSt As Single
Dim iEd As Single
For Each S In Shapes
If S.Name Like "矢印*" Then
S.Delete
End If
Next S
For Each R In Range("D8:D50")
If R.Value <> "" Then
Call MyFind(R.Value, R.Offset(0, 1).Value, iSt, iEd)
With ActiveSheet.Shapes.AddLine(iSt, R.Top + 7, iEd, R.Top + 7)
.Name = "矢印" & R.Row
.Line.EndArrowheadStyle = msoArrowheadTriangle
.Line.ForeColor.RGB = RGB(0, 0, 128)
.Line.Weight = 3
End With
End If
Next
End Sub
Private Sub MyFind(dSt As Date, dEd As Date, iSt As Single, iEd As Single)
With Range("F5")
iSt = .Left + .Width * (DateDiff("n", .Value, dSt) / 60)
iEd = .Left + .Width * (DateDiff("n", .Value, dEd) / 60)
End With
End Sub
なるべく元の変数名を維持したかったのですが、後で見直すときに戸惑いそうなので、変数名も一新しています。
開始と終了の大小比較が不要になったので、元のようにMyFindを2回呼ぶように分けても良いでしょう。
（???） 2020/02/21(金) 13:12
（F5基準に変え忘れていたため、修正）
どうでもいいんですが、マルチ先放置なので対応しておいた方がいいですよ https://oshiete.goo.ne.jp/qa/11495378.html （コナミ） 2020/02/21(金) 13:59
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.