关于excel:excel-实现甘特图

应用 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 If
End Function

Public 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 = result
End Function

Public Function IsWeekend(InputDate As Variant) As Boolean
    temp = CDate(InputDate)
    Select Case Weekday(temp)
        Case vbSaturday, vbSunday
            IsWeekend = True
        Case Else
            IsWeekend = False
    End Select
End Function

Public 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 If
End Function

Public 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