進(jìn)度管理是項(xiàng)目管理過(guò)程的一個(gè)普通應(yīng)用，很好掌握進(jìn)度狀況，可以對(duì)整個(gè)項(xiàng)目發(fā)展有一個(gè)全面掌握，對(duì)于任何事情的發(fā)展，都要有一個(gè)全面了解，特別是很重要的事情。

任何項(xiàng)目首先有個(gè)計(jì)劃，然后做出方案，接著就是進(jìn)入施工和實(shí)施階段，作為高層，并不需要了解所有的細(xì)節(jié)部分，但是清楚地知道項(xiàng)目進(jìn)行到哪一個(gè)階段是必要的一個(gè)方面。

如果對(duì)進(jìn)度沒(méi)有很好掌握，那么一些后續(xù)工作可能會(huì)受阻，進(jìn)而影響整個(gè)過(guò)程順利進(jìn)行，最終會(huì)導(dǎo)致失敗或者經(jīng)濟(jì)損失。相信這些結(jié)果，沒(méi)人喜歡看到。

本節(jié)介紹一下，關(guān)于如何利用Excel VBA制作進(jìn)度表。

其實(shí)，重點(diǎn)內(nèi)容并不是如何用代碼實(shí)現(xiàn)的細(xì)節(jié)，重點(diǎn)是要對(duì)整個(gè)表是怎樣形成的，有一個(gè)詳細(xì)理解，然后結(jié)合自己的需求，完成符合自己的進(jìn)度表，這就是一個(gè)很好學(xué)習(xí)過(guò)程。

上圖為整個(gè)工作表的結(jié)果，表的前半部分為進(jìn)度項(xiàng)目?jī)?nèi)容，后半部分為圖形化顯示的進(jìn)度結(jié)果。

本進(jìn)度表以月為單位，如果實(shí)現(xiàn)跨月進(jìn)度管理，那么就變更表結(jié)構(gòu)，所以，進(jìn)度管理也不是一個(gè)固定的模式，如果是以年或十年為單位，就另一說(shuō)了。

下圖為添加進(jìn)度對(duì)話框，為了輸入方便，直接做了窗體錄入功能，免得在工作表中出現(xiàn)錯(cuò)誤。

窗體很簡(jiǎn)單，但背后的代碼并不簡(jiǎn)單，文章后面會(huì)附一些代碼，以供學(xué)習(xí)參考。

整個(gè)工作表實(shí)現(xiàn)過(guò)程就是從這里開(kāi)始，只要錄入相應(yīng)項(xiàng)目?jī)?nèi)容，會(huì)自動(dòng)添加到工作表中，并進(jìn)行時(shí)間計(jì)算和圖形化表現(xiàn)，不需要人為干預(yù)。

要做的就是對(duì)圖表進(jìn)行分析即可。

添加按鈕代碼

Private Sub CommandButton1_Click()Dim xobj As Object, i As IntegerReDim 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 IfNext xobjSet xobj = NothinguArr(0) = "=ROW()/2-1"AddSheetRange uArr '添加內(nèi)容AddNewSheet uArr '添加記錄表End Sub

數(shù)組代碼

Private Sub getXarr() xArr = Array("序號(hào)", "部門", "類別", "項(xiàng)目名稱", _ "計(jì)劃開(kāi)始時(shí)間", "計(jì)劃結(jié)束時(shí)間", "實(shí)際開(kāi)始時(shí)間", "實(shí)際結(jié)束時(shí)間", "時(shí)長(zhǎng)")End Sub

添加項(xiàng)目過(guò)程代碼（AddSheetRange()）

Private Sub AddSheetRange(uArr)Dim s As Worksheet, cell As Range, ic As Integer, ix As IntegerDim st1 As Integer, st2 As Integer, xt1 As Integer, xt2 As IntegerSet s = ActiveSheetSet cell = s.Range("B4:AN5")cell.Insert shift:=xlDownWith 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 = "計(jì)劃" cell.Cells(2, 5).Value = "實(shí)際" cell.Cells(1, 6).Value = uArr(4) '計(jì)劃開(kāi)始時(shí)間 cell.Cells(1, 7).Value = uArr(5) '計(jì)劃結(jié)束時(shí)間 cell.Cells(2, 6).Value = uArr(6) '實(shí)際開(kāi)始時(shí)間 cell.Cells(2, 7).Value = uArr(7) '實(shí)際結(jié)束時(shí)間 cell.Cells(1, 8).Value = "=H4-G4" 'VBA.DateDiff("d", uArr(4), uArr(5)) '計(jì)劃時(shí)長(zhǎng) cell.Cells(2, 8).Value = "=H5-G5" 'VBA.DateDiff("d", uArr(6), uArr(7)) '實(shí)際時(shí)長(zhǎng) 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")) - 2End WithEnd Sub

甘特圖形的繪制是對(duì)表格樣式的一個(gè)賦值，本示例中樣式名為"S1"和"S2"。

一代碼是對(duì)樣式進(jìn)行設(shè)置的，有判斷樣式是否存在、添加等一些操作。

歡迎關(guān)注、收藏

—END—