施工進度計劃表範本，房地產項目進度計劃表

進度管理是項目管理過程的一個普通應用，很好掌握進度狀況，可以對整個項目發展有一個全面掌握，對於任何事情的發展，都要有一個全面了解，特別是很重要的事情。

任何項目首先有個計劃，然後做出方案，接着就是進入施工和實施階段，作為高層，並不需要了解所有的細節部分，但是清楚地知道項目進行到哪一個階段是必要的一個方面。

如果對進度沒有很好掌握，那麼一些後續工作可能會受阻，進而影響整個過程順利進行，最終會導致失敗或者經濟損失。相信這些結果，沒人喜歡看到。

本節介紹一下，關於如何利用Excel VBA製作進度表。

其實，重點內容並不是如何用代碼實現的細節，重點是要對整個表是怎樣形成的，有一個詳細理解，然後結合自己的需求，完成符合自己的進度表，這就是一個很好學習過程。

上圖為整個工作表的結果，表的前半部分為進度項目內容，後半部分為圖形化顯示的進度結果。

本進度表以月為單位，如果實現跨月進度管理，那麼就變更表結構，所以，進度管理也不是一個固定的模式，如果是以年或十年為單位，就另一說了。

下圖為添加進度對話框，為了輸入方便，直接做了窗體錄入功能，免得在工作表中出現錯誤。

窗體很簡單，但背後的代碼並不簡單，文章後面會附一些代碼，以供學習參考。

整個工作表實現過程就是從這裡開始，只要錄入相應項目內容，會自動添加到工作表中，並進行時間計算和圖形化表現，不需要人為干預。

要做的就是對圖表進行分析即可。

添加按鈕代碼

Private Sub CommandButton1_Click()
Dim xobj As Object, i As Integer
ReDim uArr(0 To UBound(xArr))
For Each xobj In Me.Controls
    If TypeName(xobj) = "TextBox" Then
         If VBA.Len(VBA.Trim(xobj.Value)) = 0 Then Exit Sub
            For i = 0 To UBound(xArr)
                    If xobj.Name = xArr(i) Then
                        If i = 4 Or i = 5 Or i = 6 Or i = 7 Then
                            If Not VBA.IsDate(xobj.Value) Then Exit Sub
                        End If
                        uArr(i) = xobj.Value
                    Exit For
                    End If
            Next i
    End If
Next xobj
Set xobj = Nothing
uArr(0) = "=ROW()/2-1"
AddSheetRange uArr '添加內容
AddNewSheet uArr '添加記錄表
End Sub

數組代碼

Private Sub getXarr()
    xArr = Array("序號", "部門", "類別", "項目名稱", _
                 "計劃開始時間", "計劃結束時間", "實際開始時間", "實際結束時間", "時長")
End Sub

添加項目過程代碼（AddSheetRange()）

Private Sub AddSheetRange(uArr)
Dim s As Worksheet, cell As Range, ic As Integer, ix As Integer
Dim st1 As Integer, st2 As Integer, xt1 As Integer, xt2 As Integer
Set s = ActiveSheet
Set cell = s.Range("B4:AN5")
cell.Insert shift:=xlDown
With cell
    .ClearFormats
    With .Font
        .Size = 10
        .Name = "仿宋"
    End With
    For ic = 1 To 4
         cell.Cells(1, ic).Value = uArr(ic - 1)
         s.Range(cell.Cells(1, ic), cell.Cells(2, ic)).Merge
    Next ic
     .Interior.Color = RGB(239, 239, 239)
    .Borders.LineStyle = 3
    .Borders.Color = RGB(112, 121, 211)
    cell.Cells(1, 5).Value = "計劃"
    cell.Cells(2, 5).Value = "實際"
    cell.Cells(1, 6).Value = uArr(4) '計劃開始時間
    cell.Cells(1, 7).Value = uArr(5) '計劃結束時間
    cell.Cells(2, 6).Value = uArr(6) '實際開始時間
    cell.Cells(2, 7).Value = uArr(7) '實際結束時間
    cell.Cells(1, 8).Value = "=H4-G4" 'VBA.DateDiff("d", uArr(4), uArr(5)) '計劃時長
    cell.Cells(2, 8).Value = "=H5-G5" 'VBA.DateDiff("d", uArr(6), uArr(7)) '實際時長
    st1 = VBA.Day(uArr(4)) + 8
    st2 = VBA.Day(uArr(5)) + 8
    xt1 = VBA.Day(uArr(6)) + 8
    xt2 = VBA.Day(uArr(7)) + 8
    s.Range(cell.Cells(1, st1), cell.Cells(1, st2)).Style = "S1"
    s.Range(cell.Cells(2, xt1), cell.Cells(2, xt2)).Style = "S2"
    ix = Application.WorksheetFunction.CountA(s.Range("B:B")) - 2
End With
End Sub

甘特圖形的繪製是對表格樣式的一個賦值，本示例中樣式名為”S1″和”S2″。

一代碼是對樣式進行設置的，有判斷樣式是否存在、添加等一些操作。