vba_pj_0001_auto_date
Const init_info As String = "InitInfo"
Const end_row_op As Integer = 100 'tmp
Const end_row_holiday As Integer = 100 'tmp
Const sheet_name_op As String = "Project_YY" 'tmp
Const sheet_name_holiday As String = "Holiday" 'tmp
Const column_index_task As Integer = 3 'tmp
Const column_index_cost As Integer = 5 'tmp
Const column_index_start_date As Integer = 6 'tmp
Const column_index_end_date As Integer = 7 'tmp
Const column_index_man As Integer = 8 'tmp
Const column_index_sort As Integer = 9 'tmp
Const column_index_holiday As Integer = 2 'tmp
Const column_index_workday As Integer = 3 'tmp
Function is_date_in_col(ByVal sheet_name As String, ByVal col As Integer, ByVal value As Date) As Integer
Dim end_row As Integer
end_row = end_row_holiday 'tmp get_row_range
Dim test_row As Integer
Dim ret As Integer
is_date_in_col = 0
Dim col_date As Date
For test_row = 3 To end_row
col_date = Sheets(sheet_name).Cells(test_row, col).value
If value = col_date Then
is_date_in_col = test_row
Exit For
End If
Next
End Function
Function is_date_in_holiday_list(ByVal in_date As Date) As Boolean
If is_date_in_col(sheet_name_holiday, column_index_holiday, in_date) <> 0 Then
is_date_in_holiday_list = True
Else
is_date_in_holiday_list = False
End If
End Function
Function is_date_in_workday_list(ByVal in_date As Date) As Boolean
If is_date_in_col(sheet_name_holiday, column_index_workday, in_date) <> 0 Then
is_date_in_workday_list = True
Else
is_date_in_workday_list = False
End If
End Function
Function is_satday_or_sunday(ByVal in_date As Date) As Boolean
Dim wd As Integer
wd = Weekday(in_date)
If wd = vbSunday Or wd = vbSaturday Then
is_satday_or_sunday = True
Else
is_satday_or_sunday = False
End If
End Function
Function get_next_workday(ByVal wd As Date) As Date
wd = wd + 1
While True
If is_date_in_holiday_list(wd) Then
wd = wd + 1
ElseIf is_date_in_workday_list(wd) Then
get_next_workday = wd
Exit Function
ElseIf is_satday_or_sunday(wd) Then
wd = wd + 1
Else
get_next_workday = wd
Exit Function
End If
Wend
End Function
Function calc_end_date(ByVal start_date As Date, ByVal cost_from_begin As Double, ByRef end_date As Date, ByRef cost_used As Double)
end_date = start_date
cost_used = cost_from_begin
While cost_from_begin > 1
cost_from_begin = cost_from_begin - 1
cost_used = cost_used - 1
end_date = get_next_workday(end_date)
Wend
End Function
Function get_next_task(ByRef row_edit As Integer) As Boolean
get_next_task = False
Dim in_row As Integer
in_row = row_edit
Dim new_sort As Integer
new_sort = 0
Dim in_sort As Integer
in_sort = Sheets(sheet_name_op).Cells(in_row, column_index_sort).value
Dim target_sort As Integer
Dim tmp_sort As Integer
target_sort = 32767
For i = 3 To end_row_holiday
tmp_sort = Sheets(sheet_name_op).Cells(i, column_index_sort).value
If tmp_sort > in_sort Then
get_next_task = True
If tmp_sort < target_sort Then
target_sort = tmp_sort
row_edit = i
End If
End If
Next
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> column_index_start_date Then
Exit Sub
End If
Dim cost_used As Double
cost_used = 0
Dim row_edit As Integer
row_edit = Target.Row
Dim row_edit_cost As Double
row_edit_cost = Sheets(sheet_name_op).Cells(row_edit, column_index_cost).value
Dim start_date As Date
start_date = Sheets(sheet_name_op).Cells(row_edit, column_index_start_date).value
'If start_date = "" Then
' MsgBox "have not input start date"
' Exit Sub
'End If
'if start_date is not workday then error
cost_from_begin = row_edit_cost + cost_used
Dim end_date As Date
end_date = start_date
calc_end_date start_date, cost_from_begin, end_date, cost_used
Sheets(sheet_name_op).Cells(row_edit, column_index_end_date).value = end_date
'next edit row
While get_next_task(row_edit)
start_date = end_date
If cost_used >= 1 Then
start_date = get_next_workday(start_date)
cost_used = cost_used - 1
End If
Sheets(sheet_name_op).Cells(row_edit, column_index_start_date).value = start_date
calc_end_date start_date, cost_from_begin, end_date, cost_used
Sheets(sheet_name_op).Cells(row_edit, column_index_end_date).value = end_date
Wend
End Sub
schedule.csv
No.,TaskName,,Cost,StartDate,EndDate,Man,Sort
1,TaskX,,3,,,,
2,,SubX1,1,2022/1/26,2022/1/27,Gu,2
3,,SubX2,2,,,Li,
4,TaskY,,5,,,,
5,,SubY1,2,,,Rui,
6,,SubY2,2,2022/1/24,2022/1/25,Gu,1
7,,SubY3,1,,,Rui,
8,TaskZ,,8,,,,
9,,SubZ1,3,,,Li,
10,,SubZ2,2,2022/1/29,2022/1/30,Gu,3
11,,SubZ3,3,,,Rui,
vba_pj_0001_auto_date的更多相关文章
- TCP/IP笔记(1)
TCP/IP 背景和介绍 上世纪 70 年代,随着计算机技术的发展,计算机使用者意识到:要想发挥计算机更大的作用,就要将世界各地的计算机连接起来.但是简单的连接是远远不够的,因为计算机之间无法沟通.因 ...
随机推荐
- .net core 阿里云接口之获取临时访问凭证
假设您是一个移动App开发者,希望使用阿里云OSS服务来保存App的终端用户数据,并且要保证每个App用户之间的数据隔离.此时,您可以使用STS授权用户直接访问OSS. 使用STS授权用户直接访问OS ...
- 列表(list)内置方法补充、字典(dict)内置方法、元组(tuple)内置方法、集合(set)内置方法
目录 一.列表(list)内置方法补充 二.字典(dict)内置方法 三.元组(tuple)内置方法 四.集合(set)内置方法 一.列表(list)内置方法补充 # reverse()颠倒列表内元素 ...
- MySQL索引相关知识学习心得
你知道的越多,你不知道的也就越多 -- 芝诺曾 一.MySQL索引学习 MySQl主要有两种类型的索引:哈希索引.B+树索引 1.哈希索引 哈希索引可以以O(1)的时间复杂度进行查找,但是这样查找导致 ...
- 【RocketMQ】Dledger日志复制源码分析
消息存储 在 [RocketMQ]消息的存储一文中提到,Broker收到消息后会调用CommitLog的asyncPutMessage方法写入消息,在DLedger模式下使用的是DLedgerComm ...
- flexible.js源码分析
(function flexible(window,document){ // 获取html的根元素 var docEl = document.documentElement; // dpr 物理像素 ...
- DOM05~
滚动事件和加载事件 滚动事件 加载事件 滚动事件 什么是滚动事件? 1.1 当页面进行滚动时触发的事件 1.2 作用:网页需要检测用户把页面滚动到某个区域后做一些处理 1.3 事件名:scroll 监 ...
- 异常:java.sql.SQLException: HOUR_OF_DAY: 0 -> 1解决
问题:Error attempting to get column 'xxTime' from result set. Cause: java.sql.SQLException: HOUR_OF_DA ...
- Windows.h 文件学习
SDk :软件开发工具包 Api :Windows操作系统提供给应用程序编程的接口,windows.h 窗口:窗口是屏幕上的一块矩形区域,是Windows应用程序与用户进行交互的接口,分为客户区与非 ...
- PV动态供给之nfs
需求描述:利用nfs实现PV动态供给 前提:部署好nfs服务器 这里地址是 192.168.1.35 path: /ifs/k8s NFS:是一个主流的文件共享服务器. # yum install ...
- 1970:【15NOIP普及组】扫雷游戏
1970:[15NOIP普及组]扫雷游戏 时间限制: 1000 ms 内存限制: 131072 KB提交数: 5638 通过数: 3495 [题目描述] 扫雷游戏是一款十分经典 ...