| |
[名前なし]さんのデータをテストしてみたら、0:00のところでエラーが
発生してしまいました。
ということで、mySCALE(1 to 1440)を、0 to 1439に修正しました。
Sub sub_時間計算()
Dim mySCALE(1439) 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 = 0 To Hour(myTimeE) * 60 _
+ Minute(myTimeE) - 1
mySCALE(myLooP) = 1
Next myLooP
For myLooP = Hour(myTimeS) * 60 _
+ Minute(myTimeS) To 1439
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 = 0 To 1439
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(土) 16:41 -
