Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43602 / 76736 ←次へ | 前へ→

【38181】Re:時間帯別利用率の算出
発言  sin  - 06/5/29(月) 12:09 -

引用なし
パスワード
   横から失礼します。

▼ハト さん:
お手本のようなスマートなやり方に感心しました。
勉強になります。

ところで、
>        ElseIf j = OnDate And k = OnTime Then
>          TM = Minute(ws.Cells(i, 4))

          Tm = 60 - Minute(ws.Cells(i, 4))
にしないと開始利用時間が合わないのでは?
A列の番号1は22:30なのでたまたま合うのですが
A列の番号2の13:00〜は13:00台の利用時間が0分に
A列の番号4の15:50〜は15:00台の利用時間が50分に
になってしまいます。


私はこれまで日時系の関数をほとんど使ったことがなかったので、
今回勉強のためにハト さんのコードを元にやり方を変えて
試してみました。
時系列に並べ替えて結果を表示しようというものです。
しかし、かなり不細工なコードになってしまいました。;;
特に
'日付/時間帯ごとに集計
から下の部分をもう少しスマートに出来そうな気がするのですが・・・
もしアドバイスなど頂けると幸いです。

(結局、ループが多すぎて実用には向きませんが・・・)


Sub Test2()

  Dim BDate() As Date
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim m As Integer
  Dim ws As Worksheet
  Dim SDate As Date
  Dim ed As Integer
  Dim TDate As Date
  Dim MDate As Integer
  Dim Tm As Long

  Const RCNT As Integer = 3  '総部屋数、ここでは仮に3としている

  Set ws = ThisWorkbook.ActiveSheet
  ed = ws.Range("C65535").End(xlUp).Row

  ReDim BDate(2 To ed, 2)

'行ごとにON日付/時刻、OFF日付/時刻を日付型配列に格納
  For i = 2 To ed
    BDate(i, 1) = CDate(CDate(Cells(i, 3)) & " " & CDate(Cells(i, 4)))
    BDate(i, 2) = CDate(CDate(Cells(i, 5)) & " " & CDate(Cells(i, 6)))
  Next i

'時系列に並べ替え
  For i = 2 To ed
    For j = i + 1 To ed
      If BDate(i, 1) > BDate(j, 1) Then
        TDate = BDate(i, 1)
        BDate(i, 1) = BDate(j, 1)
        BDate(j, 1) = TDate
        
        TDate = BDate(i, 2)
        BDate(i, 2) = BDate(j, 2)
        BDate(j, 2) = TDate
      End If
    Next j
  Next i

  MDate = DateDiff("d", BDate(2, 1), BDate(ed, 2))
  SDate = Format(BDate(2, 1), "yyyy/mm/dd")

  Worksheets.Add after:=ws
  Set ws = Nothing
  Set ws = ThisWorkbook.ActiveSheet


  For i = 0 To 23
    ws.Cells(1, i + 2) = i & ":00"
  Next i

  k = 2
  m = 2

'日付/時間帯ごとに集計
  For i = 0 To MDate
    ws.Cells(i + 2, 1) = DateAdd("d", i, SDate)
    TDate = DateAdd("d", i, SDate)
    
    For j = 0 To 23
      Tm = 0
      
      Do Until BDate(k, 1) >= DateAdd("h", j + 1, TDate)
        If BDate(k, 2) > DateAdd("h", j, TDate) Then
          If BDate(k, 1) > DateAdd("h", j, TDate) And BDate(k, 2) < DateAdd("h", j + 1, TDate) Then
            Tm = Tm + Minute(BDate(k, 2)) - Minute(BDate(k, 1))
          ElseIf BDate(k, 1) > DateAdd("h", j, TDate) And BDate(k, 2) >= DateAdd("h", j + 1, TDate) Then
            Tm = Tm + 60 - Minute(BDate(k, 1))
          ElseIf BDate(k, 1) <= DateAdd("h", j, TDate) And BDate(k, 2) < DateAdd("h", j + 1, TDate) Then
            Tm = Tm + Minute(BDate(k, 2))
          ElseIf BDate(k, 1) <= DateAdd("h", j, TDate) And BDate(k, 2) >= DateAdd("h", j + 1, TDate) Then
            Tm = Tm + 60
          End If
        End If
        k = k + 1
        If k > ed Then Exit Do
      Loop

      k = m

      Do Until BDate(m, 2) >= DateAdd("h", j + 1, TDate) Or m = ed
        k = m + 1
        m = m + 1
      Loop

      ws.Cells(i + 2, j + 2) = Application.Round(Tm / (60 * RCNT) * 100, 0) & " %"
    Next j
  Next i

  Columns("b:y").ColumnWidth = 5.25
  
  Set ws = Nothing

End Sub

0 hits

【38087】時間帯別利用率の算出 あい 06/5/26(金) 9:38 質問
【38094】Re:時間帯別利用率の算出 lespoir2 06/5/26(金) 10:40 回答
【38095】Re:時間帯別利用率の算出 neptune 06/5/26(金) 10:44 発言
【38102】Re:時間帯別利用率の算出 あい 06/5/26(金) 13:26 発言
【38106】Re:時間帯別利用率の算出 neptune 06/5/26(金) 14:47 回答
【38101】Re:時間帯別利用率の算出 あい 06/5/26(金) 13:23 質問
【38103】Re:時間帯別利用率の算出 M 06/5/26(金) 14:06 発言
【38110】Re:時間帯別利用率の算出 Kein 06/5/26(金) 16:04 回答
【38107】Re:時間帯別利用率の算出 ハト 06/5/26(金) 14:50 回答
【38181】Re:時間帯別利用率の算出 sin 06/5/29(月) 12:09 発言
【38198】Re:時間帯別利用率の算出 ハト 06/5/29(月) 15:16 発言
【38203】Re:時間帯別利用率の算出 sin 06/5/29(月) 17:44 発言
【38204】Re:時間帯別利用率の算出 あい 06/5/29(月) 17:50 お礼
【38108】Re:時間帯別利用率の算出 再送 ichinose 06/5/26(金) 14:59 発言
【38109】Re:時間帯別利用率の算出 再送 追伸 ichinose 06/5/26(金) 15:09 発言
【38205】Re:時間帯別利用率の算出 再送 あい 06/5/29(月) 17:52 お礼

43602 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free