こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAについて

VBAを勉強しているものです。
添付資料のようなグラフを作っております。
###############################################################
Sub 時間グラフ作成()

Dim 開始 As Date
Dim 終了 As Date
Dim 開始経過時間 As Long, 終了経過時間 As Long
Dim 開始目盛 As Long, 終了目盛 As Long

開始 = Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value
開始経過時間 = DateDiff("n", CDate("9:00"), 開始)
開始目盛 = Int(開始経過時間 / 5)
Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 開始目盛).Interior.ColorIndex = 8

If 開始 <= "11:00" And 終了 >= "12:00" Then
終了 = Worksheets("(1)(1)(1)(1)(1)").Range("G2").Value
終了経過時間 = DateDiff("n", CDate("9:00"), 終了)
終了目盛 = Int(終了経過時間 / 5)
Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 終了目盛 - 12).Interior.ColorIndex = 8
Range(Range("H2").Offset(, 開始目盛), Range("H2").Offset(, 終了目盛 - 12)).Interior.ColorIndex = 8
Else
終了 = Worksheets("(1)(1)(1)(1)(1)").Range("G2").Value
終了経過時間 = DateDiff("n", CDate("9:00"), 終了)
終了目盛 = Int(終了経過時間 / 5)
Worksheets("(2)(2)(2)(2)").Range("H2").Offset(, 終了目盛).Interior.ColorIndex = 8
Range(Range("H2").Offset(, 開始目盛), Range("H2").Offset(, 終了目盛)).Interior.ColorIndex = 8
End If

End Sub

###############################################################
休憩時間のIfの処理がうまくいかなくて困っています・・・。
&とAndで変わったり(どちらもうまくいかず)、
()をつけたりしても変わらず、そもそも根本的に
間違っているのか・・・。
よろしくお願いいたします。
(グラフの繰り返しの処理は未だ考え中で触っておりません)

投稿日時 - 2009-08-04 15:51:09

QNo.5181295

困ってます

質問者が選んだベストアンサー

>(グラフの繰り返しの処理は未だ考え中で触っておりません)
参考に
Sub 時間グラフ作成2()
  Dim 開始 As Date
  Dim 終了 As Date
  Dim 開始経過時間 As Long, 終了経過時間 As Long
  Dim 開始Rang As Range, 終了Rang As Range
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim LastRow As Long, i As Long

  Set ws1 = Worksheets("(1)(1)(1)(1)(1)")
  Set ws2 = Worksheets("(2)(2)(2)(2)")
  LastRow = ws1.Cells(Rows.Count, "F").End(xlUp).Row
  For i = 2 To LastRow
    開始 = ws1.Cells(i, "F").Value
    終了 = ws1.Cells(i, "G").Value
    開始経過時間 = DateDiff("n", CDate("9:00"), 開始)
    終了経過時間 = DateDiff("n", CDate("9:00"), 終了)
    With ws2
      Set 開始Rang = .Cells(i, "H").Offset(0, Int(開始経過時間 / 5))
      Set 終了Rang = .Cells(i, "H").Offset(0, Int(終了経過時間 / 5))
      .Range(開始Rang, 終了Rang).Interior.ColorIndex = 8
      '11:30~12:30間の塗潰し消去
      .Cells(i, "AL").Resize(1, 12).Interior.ColorIndex = xlNone
    End With
  Next
End Sub

投稿日時 - 2009-08-04 17:51:38

お礼

watabe007様

何度もありがとうございました。
おかげさまで、表として見られるところまで進むことができました。

今現在、グラフに色を塗り、休憩時間を隠すというやり方で
対応しております。時間を掛けてでも、これを当初思っていたとおり
のものに替えられるように勉強していきます。

また、今後はデータベースのように必要なものだけ引っ張り出して、
見られるような機能を追加したいとも思っております。
また解らないことが出るかと思いますので、その節はよろしくお願い
いたします。

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

投稿日時 - 2009-08-06 23:15:31

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

〔処理に必要な項の整理〕
グラフは、開始時間~終了時間 の間に背景色を付けること。
変動項目は、開始時刻、終了時刻、経過時間
準定数項目は、休憩開始時刻、休憩終了時刻
定まった(共通)の処理は、グラフを描く処理

〔大まかな処理の流れ〕
1. 休憩開始時刻、休憩終了時刻 の決定
2. 開始時刻、終了時刻 の値の取得
  → 連続取得には FOR…NEXT文、DO…LOOP文 などを使用
3. 経過時間の計算
  → IF 文などで 休憩時間の除外処理
    経過時間を5分単位の数値に換算
4. 背景色を変えるセル列の範囲(値)を算出
  → グラフ(セルの列番号)の起点、終点の調整処理
5. 算出したセル範囲の背景色を変更する


1.について : 11時台が休憩時間のようですね。
2.について : 問題ないようです。
3.について
 IF 文で処理するのは時間計算 (の内の休憩時間除外処理) だけで、背景色の処理などは、ここではしなくて後で一括処理する。
 休憩時間除外処理は、最初に、終了時刻-開始時刻=経過時間 とし、もし休憩時間を挟む場合は、算出した経過時間から休憩時間を引けばよいだけです。
4.について : 起点、終点の調整処理は、実際に走らせると修正場所が分かるはずです。
5.について : コードはこれでもよいでしょう。 グラフの就業開始時刻の位置は、中途半端な位置になっているように感じますが理由があるのでしょうね。 開始目盛の数値に修正用の数値を加減することで、任意の位置からスタートできます。

これらの点を考慮すれば、すっきりしたコードになると思います。

投稿日時 - 2009-08-04 19:30:29

お礼

KonnaMonde様

ご回答頂き、ありがとうございます。

処理の流れの解説は大変参考になります。
休憩時間の処理が未だすっきりといかないので、
参考にさせていただいて今一度考えてみたいと思います。

この度は、ありがとうございました。

投稿日時 - 2009-08-06 23:20:29

ANo.1

>休憩時間のIfの処理がうまくいかなくて困っています・・・。
休憩時間をどのように処理したいのですか
休憩時間をまたがった時、塗潰しをしたくないのなら
11:30~12:30間をあとで消しても良いのでは
Sub 時間グラフ作成()
  Dim 開始 As Date
  Dim 終了 As Date
  Dim 開始経過時間 As Long, 終了経過時間 As Long
  Dim 開始Rang As Range, 終了Rang As Range
  開始 = Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value
  終了 = Worksheets("(1)(1)(1)(1)(1)").Range("G2").Value
  開始経過時間 = DateDiff("n", CDate("9:00"), 開始)
  終了経過時間 = DateDiff("n", CDate("9:00"), 終了)
  With Worksheets("(2)(2)(2)(2)")
    Set 開始Rang = .Range("H2").Offset(0, Int(開始経過時間 / 5))
    Set 終了Rang = .Range("H2").Offset(0, Int(終了経過時間 / 5))
  End With
  Range(開始Rang, 終了Rang).Interior.ColorIndex = 8
  '11:30~12:30の塗潰し消去
  Range("Al2").Resize(1, 12).Interior.ColorIndex = xlNone
End Sub

投稿日時 - 2009-08-04 17:27:29

あなたにオススメの質問