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

whatyang

时间段组的矢量运算,自定义函数的设定见附件
时间段矢量运算_求自定义函数.rar (4.21 KB, 下载次数: 48)

2013-1-21 17:43 上传

点击文件名下载附件

（原来问题附件，已解决好的附件，可在楼下找）

感谢 香川群子 老师提供思路！
计算原理很简单，不是采用人类的复杂思维方式，而是直接使用机器的简单逻辑思维方式：
1. 1天24小时即 24*60=1440分钟，那么定义数组tms(1440)就能记录全部24小时的每一分钟了。
2. 把时间段组1的时间读入数组tms，有效的每1分钟都记录为状态1。
3. 把时间段组2的时间读入数组tms，有效的每1分钟都记录为状态1。
4. 遍历记录分钟状态的数组tms，取出有效时间段的起、始时刻，另存入数组TimeResult()。
5. 最后输出全部结果。

同谢 lee1892 老师提供的连续性对比算法！
（恩，因为我自己水平有限，看代码只明白大体意思，就不多嘴了，各位大大直接看楼下lee1892 老师的发贴吧，呵呵）

whatyang

可能还要写个判断 时间段组 间关系的子函数~但是我只会写 2个单个时间段 的关系比较，2组时间段的关系函数也不会写 >_<~~~
下面是我写的2个单时间段的比较函数      想求一个能判断2组时间段关系比较的自定义函数


Function TimeRelationship(arrTime1, arrTime2) As String    '判断2个单时间段之间的关系
    Dim StarTime1 As Date, EndTime1 As Date, StarTime2 As Date, EndTime2 As Date
    StarTime1 = arrTime1(1, 1)
    EndTime1 = arrTime1(1, 2)
    StarTime2 = arrTime2(1, 1)
    EndTime2 = arrTime2(1, 2)
   
    If StarTime2 > EndTime1 Or StarTime1 > EndTime2 Then
       TimeRelationship = "vbAway"       '相离  Away
    ElseIf StarTime1 = EndTime2 Or StarTime2 = EndTime1 Then
       TimeRelationship = "vbAdjacent"   '相临  Adjacent
    ElseIf StarTime1 <= StarTime2 And EndTime1 >= EndTime2 Then
       TimeRelationship = "vbContain"    '包含  Contain
    Else
       TimeRelationship = "vbIntersect"  '相交  Intersect
    End If
   
End Function

yaozong

Function Timex(rng1 As Range, rng2 As Range, Optional n As Long = 0) As String
Dim ar(), br()
ar = rng1
br = rng2
If ar(1, 2) < br(1, 1) Or ar(1, 1) > br(1, 2) Then
   If n = 0 Then Timex = "相离"
   If n = 1 Then Timex = Format(ar(1, 2), "hh:mm:ss") & "～" & Format(br(1, 1), "hh:mm:ss")
   If n = 2 Then Timex = Format((br(1, 1) - ar(1, 2)), "hh:mm:ss")
   If n = 3 Then Timex = Format((br(1, 1) - ar(1, 2)) * 86400, "0")
ElseIf ar(1, 2) = br(1, 1) Or ar(1, 1) = br(1, 2) Then
   If n = 0 Then Timex = "相临"
   If n = 1 Or n = 2 Or n = 3 Then Timex = "-"
Else
   If n = 0 Then Timex = "相交"
   If n = 1 Then Timex = Format(br(1, 1), "hh:mm:ss") & "～" & Format(ar(1, 2), "hh:mm:ss")
   If n = 2 Then Timex = Format(ar(1, 2) - br(1, 1), "hh:mm:ss")
   If n = 3 Then Timex = Format((ar(1, 2) - br(1, 1)) * 86400, "0")
End If
End Function

yaozong

参考附件....

whatyang

yaozong 发表于 2013-1-21 20:21
参考附件....

非常感谢，但是您这个是2个时间段，不是2组时间段，一组时间段可能有N个时间段组成的~

whatyang

顶一下~字数补丁~

lee1892

你要想学MsgBox这种vbYes、vbNo之类的表达方式，不是你这么玩得。
这个叫枚举类型，真实的值通常是整形。
参考一下我的主题贴，关于开关参数的那个。

whatyang

lee1892 发表于 2013-1-21 21:56
你要想学MsgBox这种vbYes、vbNo之类的表达方式，不是你这么玩得。
这个叫枚举类型，真实的值通常是整形。
...

感谢，不过我的主要问题不是这个。。。

香川群子

加法的函数和宏运用给你弄出来了，请看附件。


加法函数已经写好，使用方法很简单：
1. 选择输出结果区域的第一个单元格，如D32
2. 鼠标右键，出现对话框两次，分别选择要处理的【时间段组1】区域和【时间段组2】区域
3. 宏会自动计算并输出正确结果

香川群子

计算原理很简单，不是采用人类的复杂思维方式，而是直接使用机器的简单逻辑思维方式：

1. 1天24小时即 24*60=1440分钟，那么定义数组tms(1440)就能记录全部24小时的每一分钟了。
2. 把时间段组1的时间读入数组tms，有效的每1分钟都记录为状态1。
3. 把时间段组2的时间读入数组tms，有效的每1分钟都记录为状态1。
4. 遍历记录分钟状态的数组tms，取出有效时间段的起、始时刻，另存入数组TimeResult()。
5. 最后输出全部结果。

1. Function TimeAdd(arrTime1, arrTime2, Optional mode = 0)
   
2.     ReDim tms(1440)
   
3.     n1 = arrTime1.Rows.Count
   
4.     For i = 1 To n1
   
5.         t1 = arrTime1(i, 1) * 1440
   
6.         t2 = arrTime1(i, 2) * 1440
   
7.         For j = t1 To t2
   
8.             tms(j) = 1
   
9.         Next
   
10.     Next
    
11.     n2 = arrTime2.Rows.Count
    
12.     For i = 1 To n2
    
13.         t1 = arrTime2(i, 1) * 1440
    
14.         t2 = arrTime2(i, 2) * 1440
    
15.         For j = t1 To t2
    
16.             If tms(j) = 1 And mode = 1 Then
    
17.                 TimeAdd = "#VALUE!": Exit Function
    
18.             Else
    
19.                 tms(j) = 1
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     ReDim TimeResult(1 To 2, 1 To n1 + n2)
    
24.     t = 0
    
25.     For i = 1 To 1440
    
26.         If tms(i) = 1 Then
    
27.             If t = 0 Then
    
28.                 k = k + 1
    
29.                 TimeResult(1, k) = Format(i / 1440, "hh:mm")
    
30.                 t = 1
    
31.             End If
    
32.         Else
    
33.             If t = 1 Then
    
34.                 TimeResult(2, k) = Format((i - 1) / 1440, "hh:mm")
    
35.                 t = 0
    
36.             End If
    
37.         End If
    
38.     Next
    
39.     ReDim Preserve TimeResult(1 To 2, 1 To k)
    
40.     TimeAdd = Application.Transpose(TimeResult)
    
41. End Function

复制代码