'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

  

20171205xlVBA往返航班组合的更多相关文章

  1. 移动IP 它最初设想每个人都在编写应用层(7)API而不是传输层(4)API 对于QUIC,连接的标识符不是“套接字”(源/目标端口/地址协议组合)的传统概念,而是分配给连接的64位标识符

    小结: 1. 因为您对OSI模型的教育中缺少的一点是,它最初设想每个人都在编写应用层(7)API而不是传输层(4)API.应该有像应用程序服务元素之类的 东西,它们可以以标准方式处理文件传输和消息传递 ...

  2. 复杂的 Hash 函数组合有意义吗?

    很久以前看到一篇文章,讲某个大网站储存用户口令时,会经过十分复杂的处理.怎么个复杂记不得了,大概就是先 Hash,结果加上一些特殊字符再 Hash,结果再加上些字符.再倒序.再怎么怎么的.再 Hash ...

  3. JS继承之借用构造函数继承和组合继承

    根据少一点套路,多一点真诚这个原则,继续学习. 借用构造函数继承 在解决原型中包含引用类型值所带来问题的过程中,开发人员开始使用一种叫做借用构造函数(constructor stealing)的技术( ...

  4. ComponentPattern (组合模式)

    import java.util.LinkedList; /** * 组合模式 * * @author TMAC-J 主要用于树状结构,用于部分和整体区别无区别的场景 想象一下,假设有一批连锁的理发店 ...

  5. 安卓自定义组合控件--toolbar

    最近在学习安卓APP的开发,用到了toolbar这个控件, 最开始使用时include layout这种方法,不过感觉封装性不好,就又改成了自定义组合控件的方式. 使用的工具为android stud ...

  6. UML类图(下):关联、聚合、组合、依赖

    前言 上一篇文章UML类图(上):类.继承.实现,讲了UML类图中类.继承.实现三种关系及其在UML类图中的画法,本文将接着上文的内容,继续讲讲对象之间的其他几种关系,主要就是关联.聚合.组合.依赖, ...

  7. 面向组合子设计Coder

    面向组合子 面向组合子(Combanitor-Oriented),是最近帮我打开新世界大门的一种pattern.缘起haskell,又见monad与ParseC,终于ajoo前辈的几篇文章. 自去年9 ...

  8. Atitit 动态按钮图片背景颜色与文字组合解决方案

    Atitit 动态按钮图片背景颜色与文字组合解决方案 转换背景颜色,setFont("cywe_img", fontScale, 50, 5) 设置文字大小与坐标 文字分拆,使用字 ...

  9. Android自定义控件之自定义组合控件

    前言: 前两篇介绍了自定义控件的基础原理Android自定义控件之基本原理(一).自定义属性Android自定义控件之自定义属性(二).今天重点介绍一下如何通过自定义组合控件来提高布局的复用,降低开发 ...

随机推荐

  1. VS2015密钥

    Visual Studio Professional 2015简体中文版(专业版)KEY:HMGNV-WCYXV-X7G9W-YCX63-B98R2Visual Studio Enterprise 2 ...

  2. MVC 自定义特性(验证用户登录session是否已经过期)

    新建一个类 [AttributeUsage(AttributeTargets.Class | AttributeTargets.Method, AllowMultiple = false)] publ ...

  3. (转)开源项目miaosha(上)

    石墨文档:https://shimo.im/docs/iTDoZs4CVfICgSfV/ (二期)19.开源秒杀项目miaosha解读(上) [课程19]几张图.xmind0.6MB [课程19]开源 ...

  4. P4390 [BOI2007]Mokia 摩基亚(cdq分治)

    一样是cdq的板子 照着园丁的烦恼就好了 代码 #include <cstdio> #include <cstring> #include <algorithm> ...

  5. Tomcat服务器环境变量配置及在Eclipse中启动和配置

    本文原创,转载需注明出处: 如何配置在Eclipse中配置Tomcat服务器 1.在配置的时候要右击‘我的电脑‘看是否安装了jdk,配置了jdk的环境变量,看是否有classpath和path是否指向 ...

  6. python学习之re库

    正则表达式库re是非常重要的一个库. 首先正则表达式有两种表示类型,一种是raw string类型(原生字符串类型),也就是我们经常看到的r'  '的写法,另一种是不带r的写法,称为string类型. ...

  7. HDU 3848 CC On The Tree(树形dp)

    http://acm.hdu.edu.cn/showproblem.php?pid=3848 题意: 求一棵树上两个叶子结点之间的最短距离. 思路: 两个叶子节点之间一定会经过非叶子节点,除非只有两个 ...

  8. 判断是否在同一个线程-GetCurrentThreadId()用法

    线程 在一个程序中,这些独立运行的程序片断叫作"线程"(Thread),利用它编程的概念就叫作"多线程处理".利用线程,用户可按下一个按钮,然后程序会立即作出响 ...

  9. 【Selenium2】【Shell】

    E:\test_object>Python all_test.py >> report/log.txt 2>&1

  10. WebPack基本概念以及基本使用

    入门Webpack,看这篇就够了 2017年9月18日更新,添加了一个使用webpack配置多页应用的demo,可以点击此处查看 2017年8月13日更新,本文依据webpack3.5.3将文章涉及代 ...