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的更多相关文章

  1. TCP/IP笔记(1)

    TCP/IP 背景和介绍 上世纪 70 年代,随着计算机技术的发展,计算机使用者意识到:要想发挥计算机更大的作用,就要将世界各地的计算机连接起来.但是简单的连接是远远不够的,因为计算机之间无法沟通.因 ...

随机推荐

  1. Rainbond ubuntu20.04单主机(allinone)部署及简单应用构建

    1.Rainbond是什么? Rainbond 是一个云原生应用管理平台,使用简单,不需要懂容器.Kubernetes和底层复杂技术,支持管理多个Kubernetes集群,和管理企业应用全生命周期. ...

  2. 真·生产力「GitHub 热点速览」

    这些工具真的能极大提高生产力,节约你的时间来自(摸)我(鱼)增(划)值(水).先别提 style2paints,你给它随意画个草图,就能给你一个能交付给甲方爸爸的成品插画.如果提升 30%-40% 传 ...

  3. 记一次使用tika解析文件文本导致的内存溢出问题

    背景 笔者曾供职于某信息安全公司,接到过一个需求,提取文档中的文本以供后续分析.tika是apache开源的解析文档内容的组件,应用十分广泛.tika几乎支持你能想到的所有文档格式,docx , pp ...

  4. GoLang 的协程调度和 GMP 模型

    GoLang 的协程调度和 GMP 模型 GoLang 是怎么启动的 关于 GoLang 的汇编语言,请查阅 参考文献[1] 和 参考文献[2] 编写一个简单的 GoLang 程序 main.go, ...

  5. Rocky Linux安装

    1.下载 VirtualBox并安装 https://www.virtualbox.org/wiki/Downloads 2.下载Rocky Linux 选择 Rocky-9.1-x86_64-dvd ...

  6. observObservableCollection改变model属性UI不更新

    使模型类实现INotifyPropertyChanged即可 public class ResDepartmentData : INotifyPropertyChanged { //需要更新UI的属性 ...

  7. 问题记录——nginx加载lua 模块,启动报错找不到 libluajit-5.1.so.2

    环境:SUSE 12 SP3 问题说明:根据工作需求,重新编译nginx加载 lua 模块后启动报错如下: 首先是尝试在 /etc/profile 配置文件中添加环境变量并 source /etc/p ...

  8. Qt5 CMake项目简单模板

    cmake_minimum_required(VERSION 3.5) project(test VERSION 0.1 LANGUAGES CXX) set(CMAKE_INCLUDE_CURREN ...

  9. 6. Texture

    Texture 作用:可以将默认的贴图转换为自己想要的贴图类型. Texture Type: 贴图类型 Default: 默认的 Normal map: 法线贴图 Editor GUI and Leg ...

  10. 洛谷P2205 [USACO13JAN]Painting the Fence S

    题目 https://www.luogu.com.cn/problem/P2205 思路 刷水题真解压 差分就完事了 值得注意的一些东西:像这种和数轴或者坐标相关的题,还有扫描线题,一定要注意区间的开 ...