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

whatyang · 发表于 2013-1-22 16:48

香川群子发表于 2013-1-22 16:37
刚才测试了一下，自动连续运算1000次耗时1秒。→ 即代码计算每次耗时不到千分之一秒。

感谢您的测试时长~
不过实际用的时候我肯定不是手工选择数组区域,不然会死人的,呵呵~
--恩,我要再做个参数对接,这个我自己应该能捣鼓出来,万幸呀~

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

本帖最后由 lee1892 于 2013-1-23 09:46 编辑

香川群子发表于 2013-1-22 16:44
后面的问题需要考虑相邻端点问题。

不是一下子就可以解决的。

您要这么说就有点抬杠了不是，不能说有点儿麻烦就说我轻描淡写呀，能用If...Then解决的事情都不能称之为复杂。

Subtract的代码如下（未仔细调试，看个意思），前面的Merge代码稍改了一下，多出一个Unify过程，见前贴，Intersect代码结构和这个差不离吧。

代码:

Function Subtract(aRngOrg, aRngCut)
Dim nLBOrg&, nUBOrg&, nLBCut&, nUBCut&
Dim aRes#(), i&, j&, nCount&, aTemp#(), nInd&
Call Unify(aRngOrg): Call Unify(aRngCut)
nLBOrg = LBound(aRngOrg): nUBOrg = UBound(aRngOrg)
nLBCut = LBound(aRngCut): nUBCut = UBound(aRngCut)
ReDim aTemp(1 To 2, 1 To nUBOrg - nLBOrg + 1)
nInd = nLBCut
For i = nLBOrg To nUBOrg
      nCount = nCount + 1
      If nCount > UBound(aTemp) Then ReDim Preserve aTemp(1 To 2, 1 To UBound(aTemp) + 10)
      aTemp(1, nCount) = aRngOrg(i, 1): aTemp(2, nCount) = aRngOrg(i, 2)
      For j = nInd To nUBCut
         If aRngCut(j, 1) > aTemp(2, nCount) Then
            nInd = j: Exit For
         ElseIf aRngCut(j, 1) > aTemp(1, nCount) Then
            If aRngCut(j, 2) >= aTemp(2, nCount) Then
                  aTemp(2, nCount) = aRngCut(j, 1)
                  nInd = j: Exit For
            Else
                  aTemp(2, nCount) = aRngCut(j, 1)
                  nCount = nCount + 1
                  If nCount > UBound(aTemp) Then ReDim Preserve aTemp(1 To 2, 1 To UBound(aTemp) + 10)
                  aTemp(1, nCount) = aRngCut(j, 2): aTemp(2, nCount) = aTemp(2, nCount - 1)
            End If
         Else
            If aRngCut(j, 2) >= aTemp(2, nCount) Then
                  nCount = nCount - 1
                  nInd = j: Exit For
            ElseIf aRngCut(j, 2) > aTemp(1, nCount) Then
                  aTemp(1, nCount) = aRngCut(j, 2)
            End If
         End If
      Next
Next
' 增加一个判断，如果差集为空，则返回上标为-1的空数组。
If nCount >= 1 Then
      ReDim aRes(1 To nCount, 1 To 2)
      For i = 1 To nCount
         aRes(i, 1) = aTemp(1, i): aRes(i, 2) = aTemp(2, i)
      Next
      Subtract = aRes
Else
      Subtract = Array()
End If
End Function

香川群子 · 发表于 2013-1-22 22:11

做了个数组循环计算时间段组叠加的代码。
稍稍复杂一点，不知道有没有bug。

Sub kagawa_ArrTest()
arr1 = Application.InputBox("选取时间段组1所在区域", "时间段组叠加计算", Type:=8): n1 = UBound(arr1)
arr2 = Application.InputBox("选取时间段组1所在区域", "时间段组叠加计算", Type:=8): n2 = UBound(arr2)
ReDim arr3(1 To n1 + n2 + 1, 1 To 2)
i2 = 1: i3 = 1
For i1 = 1 To n1
If i3 > 1 Then
If arr1(i1, 1) > arr3(i3 - 1, 2) Then
GoTo NxtI2
Else
arr3(i3 - 1, 2) = arr1(i1, 2)
GoTo NxtI1
End If
End If
NxtI2:
If arr1(i1, 1) < arr2(i2, 1) Then
arr3(i3, 1) = arr1(i1, 1)
If arr1(i1, 2) < arr2(i2, 1) Then
arr3(i3, 2) = arr1(i1, 2)
Else
If arr1(i1, 2) < arr2(i2, 2) Then
arr3(i3, 2) = arr2(i2, 2)
Else
arr3(i3, 2) = arr1(i1, 2)
End If
i2 = i2 + 1
End If
Else
arr3(i3, 1) = arr2(i2, 1)
If arr2(i2, 2) < arr1(i1, 1) Then
arr3(i3, 2) = arr2(i2, 2)
i1 = i1 - 1
Else
If arr2(i2, 2) < arr1(i1, 2) Then
arr3(i3, 2) = arr1(i1, 2)
Else
arr3(i3, 2) = arr2(i2, 2)
End If
End If
i2 = i2 + 1
End If
i3 = i3 + 1
If i2 > n2 Then Exit For
NxtI1:
Next
For i1 = i1 + 1 To n1
arr3(i3, 1) = arr1(i1, 1)
arr3(i3, 2) = arr1(i1, 2)
i3 = i3 + 1
Next
For i2 = i2 To n2
arr3(i3, 1) = arr2(i2, 1)
arr3(i3, 2) = arr2(i2, 2)
i3 = i3 + 1
Next
ActiveCell.Resize(i3, 2) = arr3
End Sub

复制代码

香川群子 · 发表于 2013-1-22 22:13

纯粹是逐项比较计算，没有用到排序。

→ 默认时间段组1 和时间段组2 本身是已经从小到大排序的。
所以，只是把两个时间段组进行相互比较而已。

lee1892 · 发表于 2013-1-23 09:54

本帖最后由 lee1892 于 2013-1-23 10:15 编辑

就差一个了，给楼主补全吧，交集的代码如下。实际上交集和差集的代码近似度很高，倒还真可以合并成一个函数，用个开关参数来控制。

Unify 过程是对一个数组的操作：
先进行排序：1、同行小的在前，大的在后；2、二维数组两个关键字排序，第一列由小到大，第一列相同的则第二列由小到大
再进行合并：前后两个如相邻或相交则合并为一个

楼主最后一个要求的时间差之和，一个数组公式就解决了啊，不用写代码吧。

嗯，不知不觉写了个几乎是并、交、差的通用代码了，呵呵~~
使用快速排序的二维数组多关键字排序的通用代码也就是再加几行代码的事了~~

代码:

Function Intersect(aRng1, aRng2)
Dim nLB1&, nUB1&, nLB2&, nUB2&
Dim i&, j&, nCount&, aTemp#(), nInd&
Call Unify(aRng1): Call Unify(aRng2)
nLB1 = LBound(aRng1): nUB1 = UBound(aRng1)
nLB2 = LBound(aRng2): nUB2 = UBound(aRng2)
ReDim aTemp(1 To 2, 1 To nUB1 - nLB1 + 1)
nInd = nLB2
For i = nLB1 To nUB1
      nCount = nCount + 1
      If nCount > UBound(aTemp) Then ReDim Preserve aTemp(1 To 2, 1 To UBound(aTemp) + 10)
      aTemp(1, nCount) = aRng1(i, 1): aTemp(2, nCount) = aRng1(i, 2)
      For j = nInd To nUB2
         If aRng2(j, 1) > aTemp(2, nCount) Then
            nInd = j: nCount = nCount - 1: Exit For
         ElseIf aRng2(j, 1) >= aTemp(1, nCount) Then
            aTemp(1, nCount) = aRng2(j, 1)
            If aRng2(j, 2) < aTemp(2, nCount) Then
                  aTemp(2, nCount) = aRng2(j, 2)
            End If
            nInd = j
            Exit For
         Else
            If aRng2(j, 2) > aTemp(2, nCount) Then
                  nInd = j: Exit For
            ElseIf aRng2(j, 2) > aTemp(1, nCount) Then
                  aTemp(2, nCount) = aRng2(j, 2)
                  nCount = nCount + 1
                  If nCount > UBound(aTemp) Then ReDim Preserve aTemp(1 To 2, 1 To UBound(aTemp) + 10)
                  aTemp(1, nCount) = aRng2(j, 2): aTemp(2, nCount) = aRng1(i, 2)
            End If
         End If
      Next
Next
If nCount >= 1 Then
      ReDim aRes(1 To nCount, 1 To 2)
      For i = 1 To nCount
         aRes(i, 1) = aTemp(1, i): aRes(i, 2) = aTemp(2, i)
      Next
      Intersect = aRes
Else
      Intersect = Array()
End If
End Function

whatyang · 发表于 2013-1-23 16:33

本帖最后由 whatyang 于 2013-1-23 17:57 编辑

我按1440的方式整理了一下,错找到了,但是还有2个小问题,是思路方面的~ ---附件更新了~

时间自定义函数.rar (13.11 KB, 下载次数: 39)

香川群子 · 发表于 2013-1-23 17:14

lee1892 发表于 2013-1-23 09:54
就差一个了，给楼主补全吧，交集的代码如下。实际上交集和差集的代码近似度很高，倒还真可以合并成一个函数 ...

呵呵，花了不少时间吧。

…………

我前面也写了一个数组循环判断的代码。
虽然写起来也不是特别难，
但是和1440方法的简单算法比较起来，还是比较伤脑细胞的！

lee1892 · 发表于 2013-1-23 17:39

香川群子发表于 2013-1-23 17:14
呵呵，花了不少时间吧。

…………

这种大白话的代码基本取决于输入速度，而我敲键盘很快的～～{:soso_e120:}

whatyang · 发表于 2013-1-23 17:41

香川群子发表于 2013-1-23 17:14
呵呵，花了不少时间吧。

…………

原来1440的状态位是用"1"表示的,我思考了一下,时间段组1用"2",时间段组2用"1",然后把2组时间段对应的状态位加起来,那么2个时间段组原来没有覆盖到的地方是"0";是"3"的部分是交集;仍然是"2"的部分是时间段组1-组2(但是有些小瑕疵)...您抽空看一下我的附件吧,刚上传更新的~谢谢啦~

whatyang · 发表于 2013-1-23 17:43

本帖最后由 whatyang 于 2013-1-23 17:58 编辑

lee1892 发表于 2013-1-23 17:39
这种大白话的代码基本取决于输入速度，而我敲键盘很快的～～

还有个问题       再求个“临集”的函数——直接描述特点不容易，我说个实际的例子吧

      有这样2个人             班组       工号       姓名
                     12A       1234       张三
                     2A       4321       李四

      这天       12A       班次为       8:00       12:00
                              14:00       18:00
      但是张三上午8：00-12：00有事情，找李四帮他上班了（李四正好这天休息）
      在李四帮张三上班的8：00-12：00期间，工作不是很忙，领导安排12A整组8：30-9：30休息，
      但是到了12：00的时候突然忙了起来，领导要求12A加班半个小时（12：00-12：30加班）
      ——李四是帮张三顶班的，自然也跟着12A整组一起休息，一起加班喽

      于是关系如下

      张三这天的应该上班的时间关系如下                                              C             D
      原班次       称为A时间段组             调班       称为B时间段组             12A 休息             12A加班
      8:00       12:00             8:00       12:00             8：30-9：30             12：00-12：30
      14:00       18:00

      李四
      原班次                      代班                      12A 休息             12A加班
      休息，所以为空                      8:00       12:00             8：30-9：30             12：00-12：30

      调班和班组休息的时间是有交集的，所有可以直接计算，但是关于加班的时段，要看
      加班的开始时间是否与调班的结束时间相等，相等自然是代班人李四一起加班了
      但如果张三请李四代的班是8：00-11：00的，最后11：00-12：00一个小时自己赶回来上，那实际上班的人就是张三了

      所以在有人调班的时候休息、减班时间方便解决，但是加班的归属问题，要求一个“临集”了
      想也按之前的函数顺着写下来，但是数据关系不是太会确认，还请帮忙看看，谢谢了~
(上面附件上有格子,可能看的能舒服点,感谢~)
http://club.excelhome.net/forum.php?mod=attachment&aid=MTMzNzA3MXw5MTBlNWZkNXwxMzU4OTM1MDY3fDI1OTY4N3w5NzQ1NjU%3D

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

[分享] 时间段组的矢量运算,自定义函数的思路~