|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本人想使用VBA推出关键路径,代码一直报错,代码如下
Sub CalculateAndOutputCriticalPath()
Dim ws As Worksheet
Set ws = ActiveSheet
' 假设WBS表从第二行开始,且第一行为标题行
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 创建字典来存储每个任务的最早开始时间、最晚开始时间、持续时间和前置依赖
Dim taskDict As Object
Set taskDict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 2 To lastRow
Dim wbs As String
wbs = ws.Cells(i, 1).Value
Dim taskName As String
taskName = ws.Cells(i, 2).Value
Dim duration As Double
duration = ws.Cells(i, 3).Value
Dim dependencies As String
dependencies = ws.Cells(i, 4).Value
' 将任务添加到字典中,其中wbs是键
taskDict(wbs) = Array(taskName, duration, dependencies)
Next i
' 初始化最早开始时间为0
Dim earlyStart As Double
earlyStart = 0
' 计算最早开始时间
For Each wbs In taskDict.Keys
Dim duration As Double
duration = taskDict(wbs)(1)
Dim dependencies As String
dependencies = taskDict(wbs)(2)
Dim maxEarly As Double
maxEarly = earlyStart
Dim dependency As Variant
For Each dependency In Split(dependencies, ",")
If taskDict.Exists(dependency) Then
maxEarly = Application.Max(maxEarly, taskDict(dependency)(1))
End If
Next dependency
' 更新字典中任务的最早开始时间
taskDict(wbs)(1) = maxEarly + duration
' 更新最早开始时间
earlyStart = maxEarly
Next wbs
' 初始化最晚开始时间为最大值
Dim lateStart As Double
lateStart = 0
' 计算最晚开始时间
For Each wbs In taskDict.Keys
Dim duration As Double
duration = taskDict(wbs)(1)
Dim dependencies As String
dependencies = taskDict(wbs)(2)
Dim minLate As Double
minLate = lateStart
Dim dependency As Variant
For Each dependency In Split(dependencies, ",")
If taskDict.Exists(dependency) Then
minLate = Application.Min(minLate, taskDict(dependency)(1))
End If
Next dependency
' 更新字典中任务的最晚开始时间
taskDict(wbs)(3) = minLate - duration
' 更新最晚开始时间
lateStart = minLate - duration
Next wbs
' 确定关键链
Dim criticalPath As Collection
Set criticalPath = New Collection
For Each wbs In taskDict.Keys
If taskDict(wbs)(1) = taskDict(wbs)(3) Then
' 将WBS和任务名称添加到关键链集合中
criticalPath.Add wbs & " - " & taskDict(wbs)(0)
End If
Next wbs
' 输出关键链
Dim outputRow As Long
outputRow = lastRow + 2
ws.Cells(outputRow, 1).Value = "关键链:"
For Each wbs In criticalPath
outputRow = outputRow + 1
ws.Cells(outputRow, 1).Value = wbs
Next wbs
End Sub
有老师能帮忙指导一下吗?求求了
|
|