20171205xlVBA往返航班组合

'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