'ClassPlan Public Org As String
Public Des As String
Public FlyNo As String
Public StartDate As Variant
Public TextStartTime As Variant
Public TextEndTime As Variant
Public StartTime As Variant
Public EndTime As Variant
Public EndDate As Variant
Public BackDate As Variant 'mod_GetPlan
Public Sub GetPlan()
If Now() > #6/5/2018# Then Exit Sub
Dim sht As Worksheet
Dim osht As Worksheet
Set osht = ThisWorkbook.Worksheets("TOTAL")
Set sht = ThisWorkbook.Worksheets("Collocation-0")
Dim Origin, Connecting, Destination, TripDate, Stay
With sht
Origin = .Range("D3").Text
Connecting = .Range("F3").Text
Destination = .Range("H3").Text
TripDate = CDate(.Range("J3").Value)
Stay = CLng(.Range("K3").Value) .UsedRange.Offset(15).ClearContents
End With Dim dPlan As Object
Dim dUsed As Object
Dim dBackDate As Object Set dPlan = CreateObject("Scripting.Dictionary")
Set dUsed = CreateObject("Scripting.Dictionary") '记录所有航班信息
Dim Plan As ClassPlan
With osht
EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
EndCol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
PlanCount = 0
Set Rng = .Range(.Cells(1, 1), .Cells(EndRow, EndCol))
Arr = Rng.Value
DateIndex = 0
For j = LBound(Arr, 2) + 8 To UBound(Arr, 2)
'获取初始日期
If Arr(2, j) <> "" Then
StartDate = DateAdd("d", DateIndex, CDate(Format(Arr(2, j), "yyyy/mm/dd")))
End If
'获取航班日期
FlyDate = DateAdd("d", DateIndex, StartDate)
DateIndex = DateIndex + 1 '逐行检查
For i = LBound(Arr) + 5 To UBound(Arr)
If Arr(i, j) = "Y" Then
PlanCount = PlanCount + 1
Set Plan = New ClassPlan
With Plan
.FlyNo = Arr(i, 3)
.Org = Arr(i, 5)
.Des = Arr(i, 6)
.StartDate = FlyDate
.TextStartTime = Replace(Arr(i, 7), " ", "")
.StartTime = CDate(FlyDate + Arr(i, 7))
If InStr(1, Arr(i, 8), "+1") > 0 Then
et = CDate(Replace(Arr(i, 8), "+1", ""))
.EndTime = CDate(DateAdd("d", 1, FlyDate) + et)
.TextEndTime = Replace(Arr(i, 8), "+1", "")
ElseIf InStr(1, Arr(i, 8), "-1") > 0 Then
et = CDate(Replace(Arr(i, 8), "-1", ""))
.EndTime = CDate(DateAdd("d", -1, FlyDate) + et)
.TextEndTime = Replace(Arr(i, 8), "-1", "")
Else
.EndTime = CDate(FlyDate + CDate(Arr(i, 8)))
.TextEndTime = Arr(i, 8)
End If .EndDate = CDate(Format(.EndTime, "yyyy/mm/dd"))
.BackDate = Format(DateAdd("D", 0, .EndDate), "yyyy/mm/dd") 'If .FlyNo = "S73211" Then Debug.Print "结束时间："; .EndTime; "返回日期 ："; .BackDate
'Debug.Print .StartTime; " 抵达日期和时间 "; .EndTime
End With
Set dPlan(CStr(PlanCount)) = Plan
End If
Next i
Next j
End With ' 开始寻找符合条件的航班
'第一层循环 检查出发日期、出发地、中转地是否符合条件
Dim OneGo, GoBefore
Dim OneCnn, GoAfter
Dim OneBack, BackBefore
Dim OneAfter, BackAfter
Dim Index As Long
Dim HeadRow As Long
HeadRow = 15
For Each OneGo In dPlan.keys
If dUsed.exists(OneGo) = False Then
Set GoBefore = dPlan(OneGo)
'若出发日期符合条件
If Abs(DateDiff("d", GoBefore.StartDate, TripDate)) <= 3 Then
'若出发地和中转地符合条件
If GoBefore.Org = Origin And GoBefore.Des = Connecting Then
'Debug.Print GoBefore.FlyNo
dUsed(OneGo) = ""
'第二层循环 中转地、目的地、检查出发时间是否符合条件
For Each OneCnn In dPlan.keys
If dUsed.exists(OneCnn) = False Then
Set GoAfter = dPlan(OneCnn)
'若中转地和目的地符合条件
If GoAfter.Org = Connecting And GoAfter.Des = Destination Then
'若中转起飞时间符合条件
If DateDiff("h", GoBefore.EndTime, GoAfter.StartTime) > 2 And DateDiff("h", GoBefore.EndTime, GoAfter.StartTime) < 48 Then
dUsed(OneCnn) = ""
'Debug.Print GoBefore.FlyNo; " "; GoBefore.StartDate; ">>>>"; GoAfter.FlyNo; " "; GoAfter.BackDate Set dBackDate = CreateObject("Scripting.Dictionary")
'保留符合返程条件的出发日期
For off = -3 To 3
bd = Format(DateAdd("d", Stay + off, CDate(GoAfter.BackDate)), "yyyy/mm/dd")
'Debug.Print "回程日期 "; bd
dBackDate(bd) = ""
Next off '第三层循环返程
For Each OneBack In dPlan.keys
If dUsed.exists(OneBack) = False Then
Set BackBefore = dPlan(OneBack)
'回程日期
bd = Format(BackBefore.StartDate, "yyyy/mm/dd")
'若回程日期符合预设范围
If dBackDate.exists(bd) Then
'如果出发地与中转地相符，记下航班信息
If BackBefore.Org = Destination And BackBefore.Des = Connecting Then
'Debug.Print "回程航班："; BackBefore.FlyNo; " "; BackBefore.StartDate
dUsed(OneBack) = ""
'第四层循环 返程中转
For Each OneAfter In dPlan.keys
Set BackAfter = dPlan(OneAfter)
If dUsed.exists(OneAfter) = False Then
'若回程中转出发地和目的地符合条件
If BackAfter.Org = Connecting And BackAfter.Des = Origin Then
'若中转时间符合要求
If DateDiff("h", BackBefore.EndTime, BackAfter.StartTime) > 2 And DateDiff("h", BackBefore.EndTime, BackAfter.StartTime) < 48 Then dUsed(OneAfter) = ""
Index = Index + 1
With sht
Debug.Print "往返完全符合条件的线路" & Index
.Cells(Index + HeadRow, "C").Value = Index
'GO
.Cells(Index + HeadRow, "D").Value = GoBefore.FlyNo
.Cells(Index + HeadRow, "E").Value = GoBefore.StartDate
.Cells(Index + HeadRow, "F").Value = GoBefore.TextStartTime
.Cells(Index + HeadRow, "G").Value = GoBefore.TextEndTime .Cells(Index + HeadRow, "H").Value = GoAfter.FlyNo
.Cells(Index + HeadRow, "I").Value = GoAfter.StartDate
.Cells(Index + HeadRow, "J").Value = GoAfter.TextStartTime
.Cells(Index + HeadRow, "K").Value = GoAfter.TextEndTime
'Back
.Cells(Index + HeadRow, "L").Value = BackBefore.FlyNo
.Cells(Index + HeadRow, "M").Value = BackBefore.StartDate
.Cells(Index + HeadRow, "N").Value = BackBefore.TextStartTime
.Cells(Index + HeadRow, "O").Value = BackBefore.TextEndTime .Cells(Index + HeadRow, "P").Value = BackAfter.FlyNo
.Cells(Index + HeadRow, "Q").Value = BackAfter.StartDate
.Cells(Index + HeadRow, "R").Value = BackAfter.TextStartTime
.Cells(Index + HeadRow, "S").Value = BackAfter.TextEndTime End With
End If
End If
End If
Next OneAfter
End If
End If
End If Next OneBack End If
End If
End If
Next OneCnn
End If
End If
End If
Next OneGo Set dUsed = Nothing
Set dPlan = Nothing
Set sht = Nothing
Set osht = Nothing
Set dBackDate = Nothing End Sub