VBA动态数组问题：切换至下一节点时数组元素变为0或空值

问题描述 #

运行Project子程序时，每次切换到下一节点，动态数组demand、horizon、stock、production中的所有元素会变为0或空值，无法保留之前节点的数据。原代码如下：

Public Sub Project()
    
    Dim node As Integer
    node = count_node()
    
    'set up demand and horizon vector
    Dim demand() As Integer
    Dim horizon() As Integer
    ReDim demand(0 To node) As Integer
    ReDim horizon(0 To node) As Integer
    
    'generate demand and horizon value base on current node
    demand(node) = Int(50 + 450 * Rnd())
    horizon(node) = Int(10 + 30 * Rnd())
    Worksheets(2).Cells(node + 1, 1) = demand(node)
    Worksheets(2).Cells(node + 1, 2) = horizon(node)
    
    'set up stock vector and stock and their initials stock value
    Dim stock() As Integer
    ReDim stock(0 To node) As Integer
    stock(0) = 0
    Worksheets(2).Cells(1, 3) = stock(0)
    
    'set up production vector and initial production value
    Dim production() As Integer
    ReDim production(0 To node) As Integer
    production(0) = 3 * demand(0)
    Worksheets(2).Cells(1, 4) = production(0)
    
    'calculate stock at current node
    If node >= 1 Then
        stock(node) = stock(node - 1) + production(node - 1) - demand(node - 1)
    End If
    Worksheets(2).Cells(node + 1, 3) = stock(node)

    'calculate production at current node
    If node >= 1 Then
        If stock(node) < demand(node) Then
            production(node) = 3 * demand(node)
        Else
            production(node) = 0
        End If
    End If

    'update production values in the worksheet
    If node >= 1 Then
        Worksheets(2).Cells(node + 1, 4) = production(node)
    End If

    'generate demand rectangle at current node
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node), 0, horizon(node), demand(node)).Fill.ForeColor.RGB = vbRed
    'generate stock rectangle at current node
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 20, 0, 20, stock(node)).Fill.ForeColor.RGB = vbGreen
    'generate production rectangle at current node
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 40, 0, 20, production(node)).Fill.ForeColor.RGB = vbBlue
    
End Sub

Public Function count_node() As Integer
    Dim aux As Integer
    aux = 1
    While Worksheets(2).Cells(aux, 1) <> Empty
        aux = aux + 1
    Wend
    count_node = aux - 1
End Function

问题原因 #

1. 数组每次运行都被重新初始化：每次执行Project时，都会重新声明数组并执行ReDim，这会清空数组所有元素（整数数组默认值为0），仅对当前node索引赋值，之前节点的数组数据完全丢失。
2. 历史数据未恢复：计算当前节点的stock和production时，依赖前一节点的数组值，但这些值已经被重置为0，导致计算结果错误，最终表现为数组元素归零。

解决方案 #

方案1：从工作表读取历史数据（推荐） #

利用工作表存储的历史数据，每次ReDim数组后，将之前节点的数据从工作表读回数组，确保计算时能获取正确的前序值。修改后的代码如下：

Public Sub Project()
    
    Dim node As Integer
    node = count_node()
    Dim i As Integer
    
    ' 初始化并恢复demand、horizon数组
    Dim demand() As Integer
    Dim horizon() As Integer
    ReDim demand(0 To node) As Integer
    ReDim horizon(0 To node) As Integer
    
    ' 读取历史数据到数组
    For i = 0 To node - 1
        demand(i) = Worksheets(2).Cells(i + 1, 1).Value
        horizon(i) = Worksheets(2).Cells(i + 1, 2).Value
    Next i
    
    ' 生成当前节点的demand和horizon
    demand(node) = Int(50 + 450 * Rnd())
    horizon(node) = Int(10 + 30 * Rnd())
    Worksheets(2).Cells(node + 1, 1) = demand(node)
    Worksheets(2).Cells(node + 1, 2) = horizon(node)
    
    ' 初始化并恢复stock数组
    Dim stock() As Integer
    ReDim stock(0 To node) As Integer
    
    For i = 0 To node - 1
        stock(i) = Worksheets(2).Cells(i + 1, 3).Value
    Next i
    ' 仅第一个节点设置初始库存
    If node = 0 Then
        stock(0) = 0
        Worksheets(2).Cells(1, 3) = stock(0)
    End If
    
    ' 初始化并恢复production数组
    Dim production() As Integer
    ReDim production(0 To node) As Integer
    
    For i = 0 To node - 1
        production(i) = Worksheets(2).Cells(i + 1, 4).Value
    Next i
    ' 仅第一个节点设置初始生产值
    If node = 0 Then
        production(0) = 3 * demand(0)
        Worksheets(2).Cells(1, 4) = production(0)
    End If
    
    ' 计算当前节点库存
    If node >= 1 Then
        stock(node) = stock(node - 1) + production(node - 1) - demand(node - 1)
        Worksheets(2).Cells(node + 1, 3) = stock(node)
    End If

    ' 计算当前节点生产值
    If node >= 1 Then
        production(node) = IIf(stock(node) < demand(node), 3 * demand(node), 0)
        Worksheets(2).Cells(node + 1, 4) = production(node)
    End If

    ' 绘制图形
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node), 0, horizon(node), demand(node)).Fill.ForeColor.RGB = vbRed
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 20, 0, 20, stock(node)).Fill.ForeColor.RGB = vbGreen
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 40, 0, 20, production(node)).Fill.ForeColor.RGB = vbBlue
    
End Sub

Public Function count_node() As Integer
    Dim aux As Integer
    aux = 1
    While Worksheets(2).Cells(aux, 1) <> Empty
        aux = aux + 1
    Wend
    count_node = aux - 1
End Function

方案2：使用模块级变量保留数组数据 #

将数组声明为模块级变量，避免每次运行子程序时重新初始化，并用ReDim Preserve扩展数组以保留原有数据：

' 模块级变量，声明在所有子程序/函数之外
Dim demand() As Integer, horizon() As Integer
Dim stock() As Integer, production() As Integer

Public Sub Project()
    
    Dim node As Integer
    node = count_node()
    
    ' 第一次运行时初始化数组
    If node = 0 Then
        ReDim demand(0 To node) As Integer
        ReDim horizon(0 To node) As Integer
        ReDim stock(0 To node) As Integer
        ReDim production(0 To node) As Integer
        
        stock(0) = 0
        production(0) = 3 * demand(0)
        Worksheets(2).Cells(1, 3) = stock(0)
        Worksheets(2).Cells(1, 4) = production(0)
    Else
        ' 扩展数组并保留原有数据
        ReDim Preserve demand(0 To node) As Integer
        ReDim Preserve horizon(0 To node) As Integer
        ReDim Preserve stock(0 To node) As Integer
        ReDim Preserve production(0 To node) As Integer
    End If
    
    ' 生成当前节点的demand和horizon
    demand(node) = Int(50 + 450 * Rnd())
    horizon(node) = Int(10 + 30 * Rnd())
    Worksheets(2).Cells(node + 1, 1) = demand(node)
    Worksheets(2).Cells(node + 1, 2) = horizon(node)
    
    ' 计算当前节点库存
    If node >= 1 Then
        stock(node) = stock(node - 1) + production(node - 1) - demand(node - 1)
        Worksheets(2).Cells(node + 1, 3) = stock(node)
    End If

    ' 计算当前节点生产值
    If node >= 1 Then
        production(node) = IIf(stock(node) < demand(node), 3 * demand(node), 0)
        Worksheets(2).Cells(node + 1, 4) = production(node)
    End If

    ' 绘制图形
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node), 0, horizon(node), demand(node)).Fill.ForeColor.RGB = vbRed
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 20, 0, 20, stock(node)).Fill.ForeColor.RGB = vbGreen
    Worksheets(1).Shapes.AddShape(msoShapeRectangle, horizon(node) + 40, 0, 20, production(node)).Fill.ForeColor.RGB = vbBlue
    
End Sub

Public Function count_node() As Integer
    Dim aux As Integer
    aux = 1
    While Worksheets(2).Cells(aux, 1) <> Empty
        aux = aux + 1
    Wend
    count_node = aux - 1
End Function

方案说明 #

• 方案1：依赖工作表存储数据，数组与工作表数据完全同步，即使关闭Excel重新打开也能恢复历史数据，适合需要持久化数据的场景。
• 方案2：模块级变量在Excel会话中保留数据，无需每次读取工作表，效率更高，但关闭Excel后数据会丢失，且手动修改工作表时需额外同步数组与工作表数据。

内容的提问来源于stack exchange，提问作者Junjie Xia