| |
横から失礼します。
▼ハト さん：
お手本のようなスマートなやり方に感心しました。
勉強になります。
ところで、
> 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 '総部屋数、ここでは仮に３としている
Set ws = ThisWorkbook.ActiveSheet
ed = ws.Range("C65535").End(xlUp).Row
ReDim BDate(2 To ed, 2)
'行ごとにＯＮ日付/時刻、ＯＦＦ日付/時刻を日付型配列に格納
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
|
|
sin
- 06/5/29(月) 12:09 -
