エクセル2016で時間を入力して線で反映させる方法について

エクセル2016です。
B3セルに9：00
C3セルに15：00と入力します。
するとE3セルからK3セルまで線が引かれる

B4セルに15：00
C4セルに22：30と入力します。
するとL4からR4の半分まで線が引かれる。

可能でしょうか？

よろしくお願いいたします。

No.4 ベストアンサー 回答者： moto_koukousei 回答日時： 2016/09/14 21:28

No.3です。

うっかり　マクロコードの最終行を書き忘れました。
　（空白の行をカットして、再掲します）
Sub hiku()
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Delete
' データがあるのは三行目から30行目としています
For i = 3 To 30
If Cells(i, 2) = "" Then Exit Sub
If Cells(i, 3) = "" Then Exit Sub
j0 = i
jm = (Cells(j0, 1).Height) / 2 + Cells(j0, 1).Top
j1 = Hour(Cells(j0, 2)) - 4
j2 = (Cells(j0, j1).Width) * Minute(Cells(j0, 2)) / 60 + Cells(j0, j1).Left
k1 = Hour(Cells(j0, 3)) - 4
k2 = (Cells(j0, k1).Width) * Minute(Cells(j0, 3)) / 60 + Cells(j0, k1).Left
With ActiveSheet.Shapes.AddLine(j2, jm, k2, jm).Line
.ForeColor.SchemeColor = 53　　　'　線の色を変えました
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
End With
Next i
End Sub

この回答へのお礼

ありがとうございます。
チャレンジしてみます。

お礼日時：2016/09/15 10:38

No.3 回答者： moto_koukousei 回答日時： 2016/09/14 21:15

2016,2013は使ったことがないのですが、通常の機能ではたぶん出来ないと思います。

横棒グラフ機能を利用して、B列の系列のグラフ書式で塗りつぶしなしにしておけば、似たようなものを実現することは可能です。
セルの範囲を線の位置情報として利用するなら、たぶんマクロを利用するのが簡単だと思います。その場合、B4、C12等のセルに値を入れたタイミングで線を引き直すのも可能ですが、マクロが複雑になります。
たぶん簡単なのは、マクロを実行したときに全部の線を引き直してしまうという方式だと思います。
マクロを使えるならば、VBEを起動して、下記のコードを書いておき、Ｂ列，Ｃ列の値を書き直してから、マクロを実行してみてください。
下図のような線を引きます。線を引いてしまえば、行高さや列幅を変更しても、変更に応じて線の位置や長さは自動対応します。
なお、08:00以前、24:00以降のデータには対応してないマクロにしてあります。(23:59まで）

Sub hiku()

ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Delete
' データがあるのは三行目から30行目としています
For i = 3 To 30

If Cells(i, 2) = "" Then Exit Sub
If Cells(i, 3) = "" Then Exit Sub

j0 = i
jm = (Cells(j0, 1).Height) / 2 + Cells(j0, 1).Top

j1 = Hour(Cells(j0, 2)) - 4
j2 = (Cells(j0, j1).Width) * Minute(Cells(j0, 2)) / 60 + Cells(j0, j1).Left

k1 = Hour(Cells(j0, 3)) - 4
k2 = (Cells(j0, k1).Width) * Minute(Cells(j0, 3)) / 60 + Cells(j0, k1).Left

With ActiveSheet.Shapes.AddLine(j2, jm, k2, jm).Line
.ForeColor.SchemeColor = 23
.Weight = 3
.EndArrowheadStyle = msoArrowheadTriangle
End With

Next i

この回答へのお礼

ありがとうございます。

お礼日時：2016/09/15 10:39

No.2 回答者： tom04 回答日時： 2016/09/14 20:01

こんばんは！

VBAで無理やりやってみました。
↓の画像のように2行目に8～24までの整数の数値
（とりあえず時刻を表しているとします）を入力しておいてください。
そして、C列に時刻が入力されるとオートシェイプの赤の線が表示されるようにしてみました。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）
B列　→　C列の順に時刻を入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から//
Dim c As Range, r As Range, mySp As Shape
Dim startH As Range, endH As Range
Dim startM As Double, endM As Double
If Intersect(Target, Range("C:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
For Each mySp In ActiveSheet.Shapes
If mySp.Top >= .Top And mySp.Top + mySp.Height <= .Offset(1).Top Then
mySp.Delete
Exit For
End If
Next mySp
On Error Resume Next '←念のため//
If .Value <> "" Then
Set startH = Rows(2).Find(what:=Hour(.Offset(, -1)), LookIn:=xlValues, lookat:=xlWhole)
Set c = Cells(.Row, startH.Column)
startM = Minute(.Offset(, -1)) / 60
Set endH = Rows(2).Find(what:=Hour(.Value), LookIn:=xlValues, lookat:=xlWhole)
Set r = Cells(.Row, endH.Column)
endM = Minute(.Value) / 60
With ActiveSheet.Shapes.AddLine(c.Left + c.Width * startM, c.Top + c.Height / 2, _
r.Left + r.Width * endM, r.Top + r.Height / 2).Line
.ForeColor.RGB = vbRed
.Weight = 5
End With
End If
End With
End Sub 'この行まで//

＞B3セルに9：00
＞C3セルに15：00と入力します。
＞するとE3セルからK3セルまで線が引かれる
と
＞B4セルに15：00
＞C4セルに22：30と入力します。
＞するとL4からR4の半分まで線が引かれる
の両方を考えると最初のK3のつじつまが合わない
（15：30のような場合はL3セルの半分までになってしまう）ので
画像のようにJ3セルの最後までとしています。m(_ _)m

この回答へのお礼

ありがとうございます。

お礼日時：2016/09/15 10:39

No.1 回答者： GooUserラック 回答日時： 2016/09/14 19:33

「半分まで線が引かれる。

」が、出来ませんね。

この回答へのお礼

ありがとうございます。

お礼日時：2016/09/15 10:40