时间段组的矢量运算,自定义函数

yjh_27 · 发表于 2013-1-23 21:44

本帖最后由 yjh_27 于 2013-4-13 02:24 编辑

时间段组的矢量运算,自定义函数

TimeAdd

加法

函数功能：叠加两组时间段，得到一组新时间段；以数组的方式返还结果
TimeAdd(arrTime1,arrTime2,mode)

TimeMinus

减法

函数功能：从一组时间段中取出另一组时间段后，得到一组新时间段；以数组的方式返回结果
TimeMinus(arrTime1,arrTime2,mode)

TimeIntersect

交集

函数功能：求两组时间段的共有部分（交集）,产生一组新时间段；以数组的方式返回结果
TimeIntersect(arrTime1,arrTime2)

TimeAdjacent

临集(邻集)

函数功能：在arrTime2中选出所有临近（相邻）arrTime1的时间段,组成新时间段数组；以数组的方式返还结果
TimeAdjacent(arrTime1,arrTime2,mode)
增加模式选择
mode = 0 仅非交集
mode = 1 仅交集
mode = 2 全部

TimeQuantity

时间差之和

函数功能：求一组时间段每段时间差的和
TimeQuantity(arrTime,mode)
mode 为"s"时，以秒为单位返回差值的和
   为"m"时，以分钟为单位返回差值的和
   为"h"时，以小时为单位返回差值的和
   为"hm"时，以h:mm返回差值的和
   为"ms"时，以mm:ss返回差值的和
   为"hms"时，以h:mm:ss返回差值的和

2013.4.12  增加  V1.3

TimeWork

工作时间

函数功能：求一组时间段内工作时间
TimeWork(arrTime1,arrTime2,mode)
arrTime2（n,3）: 星期几工作  0  :每天
                                       空：每天
                                       1  ：星期一    以“，”相隔
                                       2  ：星期二
                                       7  ：星期日

                                       + ：调休（休息变工作）
                                          - ：调休（工作变休息）

mode 为""时，产生一组新时间段；以数组的方式返回结果
mode 为"s"时，以秒为单位返回差值的和
   为"m"时，以分钟为单位返回差值的和
   为"h"时，以小时为单位返回差值的和
   为"hm"时，以h:mm返回差值的和
   为"ms"时，以mm:ss返回差值的和
   为"hms"时，以h:mm:ss返回差值的和

只需下载最新版本，其余记录改进过程

补充内容 (2013-4-13 16:44):
请下 11L 新版（修正工作时间过0点错误）。

补充内容 (2013-4-29 14:14):
增加完工时间CompletionTime，见12L。
TimeWork  改为 WorkingHours

yjh_27 · 发表于 2013-1-23 22:00

http://club.excelhome.net/thread-974565-1-1.html
原求助帖

lee1892 · 发表于 2013-1-23 22:07

这是O(N)的原地排序法呀！{:soso_e114:}
[code=vb]Function FastSort(a)
'快速排序法
M = 1
For i = LBound(a, 1) To UBound(a, 1) - 1
If a(i, 1) <= a(i + 1, 1) Then
      If i > M Then
         M = i
      Else
         i = M
      End If
      GoTo kk:
Else
      For j = 1 To UBound(a, 2)
         x = a(i, j)
         a(i, j) = a(i + 1, j)
         a(i + 1, j) = x
      Next
      If i <> 1 Then i = i - 2
End If
kk:
Next i
FastSort = a
End Function[/code]

yjh_27 · 发表于 2013-1-23 22:10

lee1892 发表于 2013-1-23 22:07
这是O(N)的原地排序法呀！

拿来主义，只对开始时间排序，够用。

lee1892 · 发表于 2013-1-23 22:20

yjh_27 发表于 2013-1-23 22:10
拿来主义，只对开始时间排序，够用。

跟你开个玩笑的，哎～

话说你这个排序代码哪找的？冒泡排序都能写的这么花哨啊，呵呵～
而且貌似你没改好哦～

yjh_27 · 发表于 2013-1-23 22:47

lee1892 发表于 2013-1-23 22:20
跟你开个玩笑的，哎～

话说你这个排序代码哪找的？冒泡排序都能写的这么花哨啊，呵呵～

http://club.excelhome.net/thread-543994-1-1.html

有问题直说无妨。无理论基础，有些只能使用。

lee1892 · 发表于 2013-1-23 23:22

yjh_27 发表于 2013-1-23 22:47
http://club.excelhome.net/thread-543994-1-1.html

有问题直说无妨。无理论基础，有些只能使用。

你自己体会吧：

代码:

Sub test()
Dim i&, aRnd!(), arr, t#, nCount&
ReDim aRnd(1 To 10 ^ 3)
Randomize
For i = 1 To UBound(aRnd)
      aRnd(i) = Rnd
Next
arr = aRnd
t = Timer
Call Fake(arr)
Debug.Print "Fake used: " & Round(Timer - t, 2) & " seconds." & vbCrLf
For i = 1 To UBound(arr) - 1
      If arr(i) > arr(i + 1) Then Debug.Print "Fake is WRONG!": Exit For
Next
arr = aRnd
t = Timer
Call Bubble(arr)
Debug.Print "Bubble used: " & Round(Timer - t, 2) & " seconds." & vbCrLf
For i = 1 To UBound(arr) - 1
      If arr(i) > arr(i + 1) Then Debug.Print "Bubble is WRONG!": Exit For
Next
arr = aRnd
t = Timer
Call QuickSort(arr, LBound(arr), UBound(arr), nCount)
Debug.Print "QuickSort swap times: " & nCount
Debug.Print "QuickSort used: " & Round(Timer - t, 2) & " seconds." & vbCrLf
For i = 1 To UBound(arr) - 1
      If arr(i) > arr(i + 1) Then Debug.Print "QuickSort is WRONG!": Exit For
Next
End Sub

Sub Fake(arr)
Dim m&, i&, swap, nCount&
m = LBound(arr)
For i = LBound(arr) To UBound(arr) - 1
      If arr(i) <= arr(i + 1) Then
         If i > m Then m = i Else i = m
      Else
         swap = arr(i): arr(i) = arr(i + 1): arr(i + 1) = swap
         nCount = nCount + 1
         If i > LBound(arr) Then i = i - 2
      End If
Next
Debug.Print "Fake swap times: " & nCount
End Sub

Sub Bubble(arr)
Dim i&, j&, swap, nCount&
For i = LBound(arr) To UBound(arr) - 1
      For j = i + 1 To UBound(arr)
         If arr(i) > arr(j) Then
            swap = arr(i): arr(i) = arr(j): arr(j) = swap
            nCount = nCount + 1
         End If
      Next
Next
Debug.Print "Bubble swap times:" & nCount
End Sub

Sub QuickSort(arr, nLeft&, nRight&, nCount&)
Dim i&, j&, swap, key
If nLeft >= nRight Then Exit Sub
key = arr(nLeft)
i = nLeft + 1: j = nRight
Do
      Do While i <= nRight
         If arr(i) > key Then Exit Do
         i = i + 1
      Loop
      Do While j > nLeft
         If arr(j) < key Then Exit Do
         j = j - 1
      Loop
      If i >= j Then Exit Do
      swap = arr(i): arr(i) = arr(j): arr(j) = swap: nCount = nCount + 1
Loop
swap = arr(nLeft): arr(nLeft) = arr(j): arr(j) = swap: nCount = nCount + 1
Call QuickSort(arr, nLeft, j, nCount)
Call QuickSort(arr, j + 1, nRight, nCount)
End Sub

yjh_27 · 发表于 2013-1-27 14:40

应用：
统计相同或者不同日期的时间的间隔分钟数，其中22点到6点不统计

http://club.excelhome.net/forum. ... page%3D1#pid6686379 10楼

yjh_27 · 发表于 2013-3-31 13:35

应用
· 能不能在给出一个时间段后，根据这个时间段求出星期一至星期五各出现几次
9L

yjh_27 · 发表于 2013-4-13 13:57

本帖最后由 yjh_27 于 2013-4-13 19:21 编辑

修改过0点时段

补充内容 (2013-5-1 14:54):
请下载 12L 附件

		自动登录	找回密码
密码			免费注册

[原创] 时间段组的矢量运算,自定义函数

评分

评分