| |
▼みなみ さん：
１日分の数直線に見立てた変数（mySCALE）を用意し、
該当のところを塗りつぶす（1を立てる）ようにし、
その数を数えてみました。
リンク先はよく見てませんが、似たような考えだと思います（多分）
Sub sub_時間計算()
Dim mySCALE(1 To 1440) As Integer
Dim myCALC(1 To 31) As Long
Dim myTimeS As Date
Dim myTimeE As Date
Dim myRange As Range
Dim myLastR As Range
Dim myDay As Long
Dim myLooP As Long
Sheets("Sheet1").Activate
Set myLastR = Cells(Cells.Rows.Count, 1).End(xlUp)
For myDay = 1 To 31
Erase mySCALE
For Each myRange In Range("A1", myLastR)
If myRange.Value = myDay Then
myTimeS = myRange.Offset(0, 1).Value
myTimeE = myRange.Offset(0, 2).Value
If myTimeS > myTimeE Then
For myLooP = 1 To Hour(myTimeE) * 60 _
+ Minute(myTimeE) - 1
mySCALE(myLooP) = 1
Next myLooP
For myLooP = Hour(myTimeS) * 60 _
+ Minute(myTimeS) To 1440
mySCALE(myLooP) = 1
Next myLooP
Else
For myLooP = Hour(myTimeS) * 60 + Minute(myTimeS) _
To Hour(myTimeE) * 60 + Minute(myTimeE) - 1
mySCALE(myLooP) = 1
Next myLooP
End If
End If
Next myRange
For myLooP = 1 To 1440
myCALC(myDay) = myCALC(myDay) + mySCALE(myLooP)
Next myLooP
Next myDay
Sheets("Sheet2").Range("B1").Resize(UBound(myCALC)).Value = _
Application.Transpose(myCALC)
End Sub
それでは。(^･ω･^)
|
|
飛ばない豚
- 06/8/19(土) 15:16 -
