代码无法运行，一直报错

Nick_Chen0622

本人想使用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
有老师能帮忙指导一下吗？求求了

xlj310

变量重复声明
taskDict(wbs)(1) = maxEarly + duration
这个你想投机取巧，可惜，字典Item为数组时，不支持这么改，要取出再修改，然后再放入对应Key的item

xlj310

xlj310 发表于 2024-10-30 09:17
变量重复声明
taskDict(wbs)(1) = maxEarly + duration
这个你想投机取巧，可惜，字典Item为数组时，不支 ...

temp = 任务Dic(wbs)
temp(1) = 最早开始 + 持续时间
任务Dic(wbs) = temp

xlj310

VBA是支持中文变量的，能用中文的地方，尽量用中文，可读性比你用英文变量强很多。
帮你大致改了一下，至少可以运行起来了，结果如果不正确，你自己再打断点调试一下：
Sub CalculateAndOutputCriticalPath()
    Set 工作表 = ThisWorkbook.Worksheets(1)
    最行 = 工作表.Cells(工作表.Rows.Count, "A").End(xlUp).Row
    Set 任务Dic = CreateObject("Scripting.Dictionary")
    For i = 2 To 最行
        wbs = CStr(工作表.Cells(i, 1).Value)
        任务名称 = 工作表.Cells(i, 2).Value
        持续时间 = 工作表.Cells(i, 3).Value
        前置依赖 = 工作表.Cells(i, 4).Value
        任务Dic(wbs) = Array(任务名称, 持续时间, 前置依赖) ' 将任务添加到字典中，其中wbs是键
    Next i
    最早开始 = 0 ' 初始化最早开始时间为0
    For Each wbs In 任务Dic.Keys
        持续时间 = 任务Dic(wbs)(1)
        前置依赖 = 任务Dic(wbs)(2)
        For Each 前置依赖 In Split(前置依赖, ",")
            If 任务Dic.Exists(前置依赖) Then
                最早开始 = Application.Max(最早开始, 任务Dic(前置依赖)(1))
            End If
        Next 前置依赖
        temp = 任务Dic(wbs)
        temp(1) = 最早开始 + 持续时间
        任务Dic(wbs) = temp
    Next wbs
    最晚开始 = 0 ' 初始化最晚开始时间为最大值
    For Each wbs In 任务Dic.Keys ' 计算最晚开始时间
        持续时间 = 任务Dic(wbs)(1)
        前置依赖 = 任务Dic(wbs)(2)
        For Each 前置依赖 In Split(前置依赖, ",")
            If 任务Dic.Exists(前置依赖) Then
                最晚开始 = Application.Min(最晚开始, 任务Dic(前置依赖)(1))
            End If
        Next 前置依赖
        temp = 任务Dic(wbs)
        temp(2) = 持续时间 - 最晚开始
        任务Dic(wbs) = temp
    Next wbs
    Dim 关键路径 As Collection
    Set 关键路径 = New Collection ' 确定关键链
    For Each wbs In 任务Dic.Keys
        If 任务Dic(wbs)(1) = 任务Dic(wbs)(2) Then
            关键路径.Add wbs & " - " & 任务Dic(wbs)(0) ' 将WBS和任务名称添加到关键链集合中
        End If
    Next wbs
    输出行 = 最行 + 2
    工作表.Cells(输出行, 1).Value = "关键链：" ' 输出关键链
    For Each wbs In 关键路径
        输出行 = 输出行 + 1
        工作表.Cells(输出行, 1).Value = wbs
    Next wbs
End Sub