| |
こんなのでも善いかな？
データは必ずA列がB列より小さい
データはA列をKeyとして並べ替えられる
結果の出力位置は、D、E、F列とする
Option Explicit
Public Sub TimeCalc()
Const lngColCount As Long = 3
Dim i As Long
Dim j As Long
Dim rngList As Range
Dim vntData As Variant
Dim vntResult As Variant
Dim lngArrayEnd As Long
'データListの範囲を取得
Set rngList = ActiveSheet.Cells(1, "A").CurrentRegion
'データ範囲をソート
With rngList
.Sort _
Key1:=.Item(1, 1), Order1:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
End With
vntData = rngList.Value
'時間の重なりを除去したデータの配列を作成
j = 1
ReDim vntResult(1 To lngColCount, 1 To j)
vntResult(1, j) = vntData(j, 1)
vntResult(2, j) = vntData(j, 2)
For i = 2 To UBound(vntData, 1)
If vntData(i, 1) > vntResult(2, j) Then
j = j + 1
ReDim Preserve vntResult(1 To lngColCount, 1 To j)
vntResult(1, j) = vntData(i, 1)
vntResult(2, j) = vntData(i, 2)
Else
If vntResult(1, j) <= vntData(i, 1) Then
If vntResult(2, j) < vntData(i, 2) Then
vntResult(2, j) = vntData(i, 2)
End If
End If
End If
Next i
'分を集計
j = j + 1
ReDim Preserve vntResult(1 To lngColCount, 1 To j)
For i = 1 To j - 1
vntResult(3, i) = vntResult(2, i) - vntResult(1, i)
vntResult(3, j) = vntResult(3, j) + vntResult(3, i)
Next i
'結果出力
With rngList(1, rngList.Columns.Count + 2)
'時分に書式設定
With .Resize(j, lngColCount - 1)
.NumberFormat = "h:mm"
End With
'分に書式設定
With .Offset(, 2).Resize(j)
.NumberFormat = "[mm]"
End With
'結果を出力
With .Resize(j, lngColCount)
.Value = Application.Transpose(vntResult)
End With
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 04/5/4(火) 16:21 -
