应用excel，实现项目管理甘特图

演示

操作

  1. 设置根本信息
  2. 填入需要及对应工期
  3. 抉择需要，跟进人，启动日期，将主动生成甘特图

波及的VB代码

Public Function GetArrayLength(arr As Variant) As Integer   If IsEmpty(arr) Then      GetArrayLength = 0   Else      GetArrayLength = UBound(arr) - LBound(arr) + 1   End IfEnd FunctionPublic Function IsNull(val As Variant) As Boolean    Dim result    If val = "" Then        result = True    ElseIf IsEmpty(val) Then        result = True    Else        result = False    End If    IsNull = resultEnd FunctionPublic Function IsWeekend(InputDate As Variant) As Boolean    temp = CDate(InputDate)    Select Case Weekday(temp)        Case vbSaturday, vbSunday            IsWeekend = True        Case Else            IsWeekend = False    End SelectEnd FunctionPublic Function GetExceptCollection(r1 As range, r2 As range, Optional offset$ = 0) As Variant    Dim arr1, arr2, arr3(), i&, row        row = Application.ThisCell.row - offset    arr1 = Application.Transpose(r1)    arr2 = Application.Transpose(r2)        Dim dict As Object    Set dict = CreateObject("scripting.dictionary")    For Each a In arr2        If Not IsNull(a) Then            dict(a) = 1        End If    Next        ReDim arr3(GetArrayLength(arr1))        For Each a In arr1        If Not IsNull(a) And Not dict.exists(a) Then            i = i + 1            arr3(i) = a        End If    Next        If Not IsNull(arr3(row)) Then        GetExceptCollection = arr3(row)    Else        GetExceptCollection = ""    End IfEnd FunctionPublic Function GetEndDateByDuration(startDateV As Variant, durationI As Integer, holidaysR As range, workdaysR As range) As Date        If IsNull(startDateV) Then        GetEndDateByDuration = ""    End If        startDateD = CDate(startDateV)        If Not IsDate(startDateD) Then         GetEndDateByDuration = ""    End If            Dim holidaysA, workdaysA, holidaysD As Object, workdaysD As Object    holidaysA = Application.Transpose(holidaysR)    workdaysA = Application.Transpose(workdaysR)        Set holidaysD = CreateObject("scripting.dictionary")       For Each a In holidaysA        temp = CDate(a)        If Not IsNull(temp) Then            holidaysD(temp) = 1        End If    Next        Set workdaysD = CreateObject("scripting.dictionary")    For Each a In workdaysA        temp = CDate(a)        If Not IsNull(temp) Then            workdaysD(temp) = 1        End If    Next    Dim actualDurationI As Integer, index As Integer        Do While index < durationI        temp = startDateD + actualDurationI                If workdaysD.exists(temp) Then            index = index + 1        ElseIf holidaysD.exists(temp) Then        ElseIf IsWeekend(temp) Then        Else            index = index + 1        End If                actualDurationI = actualDurationI + 1    Loop           GetEndDateByDuration = startDateD + actualDurationI - 1    End Function

Excel文件

https://github.com/chencaize/fileRepo/blob/main/%E7%94%98%E7%89%B9%E5%9B%BE.xlsm