|
发表于 2016-6-22 20:43
|
显示全部楼层
本楼为最佳答案
本帖最后由 老司机带带我 于 2016-6-22 20:56 编辑
我的结果跟你公式的结果有几个有一点不一样,你自己再看下:- Sub xx()
- Dim n&, ts As Date, tx As Date, sd As Date, xd As Date, ts1 As Date, tx1 As Date
- Dim arr, brr(), i&
- With Sheet1
- n = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("C2:F" & n)
- On Error Resume Next
- For i = 1 To n - 1
- ReDim Preserve brr(1 To 2, 1 To i)
- If arr(i, 3) <> "" And arr(i, 4) <> "" Then
- If TimeValue(arr(i, 3)) > TimeValue("7:40:00") Then
- ts = arr(i, 3)
- Else
- ts = TimeValue("7:30:00")
- End If
- If TimeValue(arr(i, 4)) > TimeValue("16:20:00") Then
- tx = TimeValue("16:30:00")
- Else
- tx = arr(i, 4)
- End If
- If ts > TimeValue("11:00:00") And ts < TimeValue("12:00:00") Then
- brr(1, i) = (tx - TimeValue("12:00:00")) * 24
- ElseIf ts > TimeValue("11:00:00") And ts > TimeValue("12:00:00") Then
- brr(1, i) = (tx - ts) * 24
- Else
- brr(1, i) = (TimeValue("11:00:00") - ts + tx - TimeValue("12:00:00")) * 24
- End If
- If TimeValue(arr(i, 4)) > TimeValue("17:00:00") Then brr(2, i) = (TimeValue(arr(i, 4)) - TimeValue("16:30:00")) * 24
- End If
- Next
- .Range("K2").Resize(n - 1, 2) = Application.WorksheetFunction.Transpose(brr)
- End With
- End Sub
复制代码 |
|