|
发表于 2016-12-13 10:17
|
显示全部楼层
本楼为最佳答案
未考虑双周末及法定假日。
- Sub 生成()
- arr = Sheets(1).[a1].CurrentRegion
- [a2:t1000].ClearContents
- ReDim brr(1 To 1000, 1 To UBound(arr, 2))
- For i = 2 To UBound(arr)
- If arr(i, 4) = "同意" Then
- ks = arr(i, 16): js = arr(i, 17) '开始、结束
- d = DateDiff("d", ks, js) '相隔天数
- For k = 0 To d
- n = n + 1
- For j = 1 To UBound(arr, 2)
- brr(n, j) = arr(i, j)
- Next
- If d > 0 Then
- brr(n, 17) = IIf(k < d, DateSerial(Year(ks), Month(ks), Day(ks + k)) & " 16:30", js) '结束时间(16.30或最后一天结束时间)
- If k >= 1 Then
- brr(n, 16) = DateSerial(Year(ks), Month(ks), Day(ks) + k) & " 08:00" '8点
- brr(n, 18) = 8
- End If
- If k = 0 Or k = d Then brr(n, 18) = Int(24 * (TimeValue(brr(n, 17)) - TimeValue(brr(n, 16))))
- End If
- Next
- End If
- Next
- [a2].Resize(n, UBound(arr, 2)) = brr
- ActiveSheet.Columns.AutoFit
- End Sub
复制代码 |
|