一个时间段排斥下的会议安排问题

改写了一下，通用一些
'类名：会议安排
'说明: 属性IsPointRepeat，确定时间点是否可以重复，如[1-3][3-4]
' 方法AddMeeting(lngStart,lngEnd,anyValue):lngStart开始时间，lngEnd结束时间，anyValue需要安排的具体值
' 方法GetResult()返回安排后的anyValue数组
Class CMeetingManage
Private m_lngCount
Private m_alngStart(),m_alngEnd(),m_aanyValue()
Private m_ablnEnabled() '计算后，需要抛弃一些冲突项，此值用于表示记录是否可用
Private m_blnPointRepeat

Private Sub Class_Initialize()
m_lngCount=0
m_blnPointRepeat=True
End Sub

Private Sub Class_terminate()
Erase m_alngStart
Erase m_alngEnd
Erase m_ablnEnabled
Erase m_aanyValue
End Sub

'是否允许点重复,例如[1-2][2-3]这种情况，称为点重复
Public Property Let IsPointRepeat(bln)
m_blnPointRepeat=bln
End Property

'按照会议安排算法冲突处理，
Private Function ConflictDispose()
Dim i,j,k,a,b,c

i=0
j=i+1
Do While j<m_lngCount 'error:j<m_lngCount-1,last value error
' If m_alngEnd(i) >= m_alngStart(j) Then '存在冲突,点无重复
If ConfilctDetect(i,j) Then '存在冲突
If m_alngEnd(i)<=m_alngEnd(j) Then
'丢弃j
m_ablnEnabled(j)=False
j=j+1
Else
'丢弃i
m_ablnEnabled(i)=False
i=j
j=i+1
End If
Else '不存在冲突,处理下一个
i=j
j=i+1
End If
Loop

End Function

'冲突检测
Private Function ConfilctDetect(i,j)
If m_blnPointRepeat Then
ConfilctDetect=(m_alngEnd(i) >m_alngStart(j))
Else
ConfilctDetect=(m_alngEnd(i) >=m_alngStart(j))
End If
End Function

'返回结果，若为空，则返回Empty
Public Function GetResult()
Dim i,j,k
Dim aanyRet(),lngRetCount,blnIsObject
lngRetCount=0

Call SortByStart()
Call ConflictDispose()

If m_lngCount>0 Then blnIsObject=IsObject(m_aanyValue(0))
For i=0 To m_lngCount-1
If m_ablnEnabled(i) Then
ReDim preserve aanyRet(lngRetCount)
If blnIsObject Then
Set aanyRet(lngRetCount)=m_aanyValue(i)
Else
aanyRet(lngRetCount)=m_aanyValue(i)
End If
lngRetCount=lngRetCount+1
End If
Next

If lngRetCount>0 Then GetResult=aanyRet 'error:空返回错误
End Function

'按m_alngStart排序数组,由小到大
Private Function SortByStart()
'采用冒泡算法
Dim i,j,k,intTmp1,intTmp2
For i=m_lngCount-1 To 1 Step -1
For j=0 To i-1
If m_alngStart(j)>m_alngStart(j+1) Then Call SwitchMeeting(j,j+1)
Next
Next
End Function

Public Function AddMeeting(lngStart,lngEnd,anyValue)
ReDim Preserve m_alngStart(m_lngCount)
ReDim Preserve m_alngEnd(m_lngCount)
ReDim preserve m_aanyValue(m_lngCount)
ReDim preserve m_ablnEnabled(m_lngCount)
m_alngStart(m_lngCount)=lngStart
m_alngEnd(m_lngCount)=lngEnd
If IsObject(anyValue) Then '操你妈个傻VBS
Set m_aanyValue(m_lngCount)=anyValue
Else
m_aanyValue(m_lngCount)=anyValue
End If
m_ablnEnabled(m_lngCount)=True
m_lngCount=m_lngCount+1
End Function

Public Function SwitchMeeting(i,j)
Dim lngStart,lngEnd,anyValue

lngStart=m_alngStart(i)
m_alngStart(i)=m_alngStart(j)
m_alngStart(j)=lngStart

lngEnd=m_alngEnd(i)
m_alngEnd(i)=m_alngEnd(j)
m_alngEnd(j)=lngEnd

If IsObject(m_aanyValue(i)) Then
Set anyValue=m_aanyValue(i)
Set m_aanyValue(i)=m_annyValue(j)
Set m_aanyValue(j)=anyValue
Else
anyValue=m_aanyValue(i)
m_aanyValue(i)=m_aanyValue(j)
m_aanyValue(j)=anyValue
End If
End Function

Public Function Debug()
Dim i,t,k
Randomize
For i=1 To 20
t=CLng(100*rnd)
k=t+clng(10*rnd)+1
Call addMeeting(t,k,"[" & t & "-" & k & "]")
Next
MsgBox Join(GetResult,vbcrlf)
End Function
End Class

====================================================================================
附录1：问题来源"日期不能交叉的检测算法(头都想痛了)"
http://topic.csdn.net/u/20080121/15/3c8733a6-fef8-46d2-9031-08d299c97dc2.html

====================================================================================
附录2：在算法区的讨论"一个时间段排斥的最多段算法"
http://topic.csdn.net/u/20080121/19/aa2e9d5c-ae95-4435-94d9-0fe0c029616c.html