dポイントプレゼントキャンペーン実施中!

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
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

よろしくお願いしますm(__)m

「VBAを使用して時間単位で矢印をひきたい」の質問画像

A 回答 (3件)

こんにちは!



列方向に関しては1列が1時間というコトですかね。
細かい分までは判らないかもしれませんが、とりあえずやってみました。

一例です。

Sub Sample1()
 Dim i As Long
 Dim c As Range, r As Range
 Dim myStart, myEnd

  ActiveSheet.Lines.Delete
  For i = 6 To Cells(Rows.Count, "D").End(xlUp).Row
   myStart = Application.Match(Cells(i, "D"), Rows(5), True)
   myEnd = Application.Match(Cells(i, "E"), Rows(5), True)
    If IsNumeric(myStart) And IsNumeric(myEnd) Then '//←念のため//
     Set c = Cells(i, myStart)
     Set r = Cells(i, myEnd)
      With ActiveSheet.Shapes.AddLine(c.Left + c.Width * Minute(Cells(i, "D")) / 60, c.Top + c.Height / 2, _
       r.Left + r.Width * Minute(Cells(i, "E")) / 60, r.Top + r.Height / 2).Line
        .ForeColor.RGB = RGB(0, 0, 255) '//←「青」(色は好みで!)★//
        .Weight = 2 '//←太さは好みで!★//
        .EndArrowheadStyle = msoArrowheadTriangle
      End With
    End If
  Next i
End Sub

※ 最初に記載したように○分の部分は正確に判らないかもしれませんが、
感じとしては「このあたり!」と判別できると思います。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとう

ありがとうございました!
できました(^^)

お礼日時:2020/02/25 09:07

こんにちは



ご提示のコードがどのような方法をとっているか理解なさっているのかわかりませんが、
「指定時刻と5行目に記載の時間を比較して一致しているものを探す」方式です。
このため、D,E列に記入する時刻は、5行目に存在する時刻と一致するように入力しないとうまく動作しないという大きなデメリットがあるように思われます。
一方で、5行目の表記は連続しなくても自由に設定できるというメリットはありますが、逆に、必ず時刻表示の行(5行目)が必要となります。
この方式とは別の考え方として、スタートを「0時」として以降は「1時間/1セル」として計算するとか、他の方式もあり得ると考えられます。

>分単位で矢印の長さが変わるようにするにはどのようにしたら良いのでしょうか?
計算を分単位に応じて行うようにすれば良いですが、上記のような条件群のうち何を実際の前提条件とするかによっても、コードは変わってくるものと考えられます。

いずれにしろ、考え方としてはどの場合も同様で、「1時間/1セル」という前提で良いのならば、
与えられた時刻(シリアル値)に対して
Hour(シリアル値)
Minute(シリアル値)
でそれぞれ時刻、分が得られますので、これによりセルの位置を決定し、
 セル幅×分数/60
でそのセル内でのチャートの表示長さを算出することができます。

仮に、全てのセル幅が一律であるという保証があるなら、
 (時間数 + 分数/60)× 単位セル幅
で、線分の長さを直接求めることもできるでしょう。
なお、この値はシリアル値の差分から
 (シリアル値-INT(シリアル値))×24×単位セル幅
で直接求めても同じ結果になるはずです。

線分の開始位置も同様の要領で求められますので、「開始位置」から「開始位置+線分長さ」の位置までラインを引けば、分単位に対応したラインを引くことができるでしょう。
    • good
    • 0

回答ではありません。

提案となります。
① このレイアウトではジャスト9時とかが、どこだかわかりにくいですよね?
  下図のようにセル結合して2セルで1時間にされた方が良いと思いますがいかがでしょうか?
② 1分単位で表示するならば、1分1ピクセルの倍数にされた方が良いと思いますがいかがでしょうか?
  1分1ピクセルの場合、下図のようにセル結合し時にはセル幅が「3.13」になります。
③ 時刻表示ですが、表示形式を「[hh]:mm」にして24時間以上も「時間:分」表示にされた方が良いと思いますがいかがでしょうか?
「VBAを使用して時間単位で矢印をひきたい」の回答画像1
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています