| |
[#41483]のかみちゃんさんのコードを元に、
>時間順にソートして２行目のＡが１行目のＢより大きければ重なり無しとみなし、
>小さければ２行目のＡが１行目のＡより大きくて、２行目のＢが１行目のＢより
>大きければＢの値を上書きしていく
というコードにしてみました。
Sub Macro1()
Dim LastCell As Range
Dim c As Range
'日別集計用の変数31要素
Dim vntData(1 To 31) As Long 'ちょっと変更
Dim DayNum As Long, TimeS As Date, TimeL As Date '追加
Dim TimeS1 As Date, TimeL1 As Date '追加
Sheets("Sheet1").Activate
'日→時間1→時間2の順で並べ替え
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Key2:=Range("B1"), _
Key3:=Range("B3"), Header:=xlNo
Set LastCell = Cells(Cells.Rows.Count, 1).End(xlUp)
DayNum = 0
For Each c In Range("A1", LastCell)
'以下変更
TimeS1 = c.Offset(, 1).Value '時間1を取得
TimeL1 = c.Offset(, 2).Value '時間2を取得
If TimeS1 > TimeL1 Then TimeL1 = TimeL1 + 1 '24時をまたがる場合
If Val(c.Value) = DayNum Then '日が同じ場合
'保存している時間2と比較して、時間2が小さい場合
'→計算済みの時間と完全に重複しているので、DateDiffの結果を0にする
If TimeL > TimeL1 Then
TimeS = TimeL
Else
TimeS = TimeS1
'保存している時間2と比較して、時間1のほうが小さい場合
'→重複している時間を除く
If TimeS < TimeL Then TimeS = TimeL
TimeL = TimeL1
End If
Else '日が変わった場合
TimeS = TimeS1
TimeL = TimeL1
End If
'配列に結果を計算
vntData(Val(c.Value)) = vntData(Val(c.Value)) + DateDiff("n", TimeS, TimeL)
DayNum = Val(c.Value) '日を保存
'-- ※1 D列に時間(分)を出力する部分(不要なら削除)
c.Offset(, 3).Value = DateDiff("n", TimeS1, TimeL1) 'D列に出力
'--------------------------------------------------------------------------
'-- ※2 E,F列に実際に計算に使う時刻を出力する部分(不要なら削除)
With WorksheetFunction
c.Offset(, 4).Value = .Text(TimeS, "[hh]:mm:ss") 'E列に出力
c.Offset(, 5).Value = .Text(TimeL, "[hh]:mm:ss") 'F列に出力
End With
'--------------------------------------------------------------------------
Next
Sheets("Sheet2").Range("B1").Resize(UBound(vntData)).Value = _
Application.Transpose(vntData)
MsgBox "集計完了"
End Sub
一応、下記のようなデータで確かめました。
A B
2 10:00 10:30
2 10:00 11:00
2 10:40 11:10
4 13:20 13:50
4 14:00 14:30
4 23:00 0:10
6 9:00 9:50
6 9:30 10:10
7 9:30 10:50
7 10:00 10:40
7 10:20 10:50
7 10:30 11:00
8 23:00 0:30
8 23:20 0:10
8 23:50 1:00
9 0:00 0:30
9 23:00 0:00
9 23:30 0:50
|
|
[名前なし]
- 06/8/19(土) 16:15 -
