如何正确初始化数组且不清除已存值——VBA用户窗体问题

问题背景 #

我有一个带两个ListBox（ListBox1、ListBox2）的用户窗体，可通过Add/Remove按钮交换项目。ListBox1初始从Excel单元格区域加载数据，ListBox2初始为空。我编写了SaveItems()和LoadSavedItems()两个子过程，期望关闭窗体后再次打开时，列表框能加载上次保存的内容。

现有代码 #

Private saveditems_lstbox1() As Variant
Private saveditems_lstbox2() As Variant


Private Sub SaveItems()
    
    If ListBox1.ListCount <> 0 Then
        ReDim saveditems_lstbox1(ListBox1.ListCount - 1)
        For i = 0 To ListBox1.ListCount - 1
            saveditems_lstbox1(i) = ListBox1.List(i)
        Next i
    End If
    
    If ListBox2.ListCount <> 0 Then
        ReDim saveditems_lstbox2(ListBox2.ListCount - 1)
        For i = 0 To ListBox2.ListCount - 1
            saveditems_lstbox2(i) = ListBox2.List(i)
        Next i
    End If
    
End Sub


Private Sub LoadSavedItems()
    
    Dim i As Long 
         
    If Not IsEmpty(saveditems_lstbox1) Then   
        ListBox1.Clear
        For i = LBound(saveditems_lstbox1) To UBound(saveditems_lstbox1)
            ListBox1.AddItem saveditems_lstbox1(i)
        Next i
    End If

    If Not IsEmpty(saveditems_lstbox2) Then    
        ListBox2.Clear
        For i = LBound(saveditems_lstbox2) To UBound(saveditems_lstbox2)
            ListBox2.AddItem saveditems_lstbox2(i)
        Next i
    End If

End Sub


Private Sub UserForm_Initialize()
   If IsEmpty(saveditems_lstbox1) Then 
        Dim Arr
        Dim last_row_A As Long
        
        last_row_B = Cells(Rows.Count, "B").End(xlUp).Row
        Arr = Range("A" & 1 & ":A" & last_row_A)

        ListBox1.List() = Arr
    
    Else    
        LoadSavedItems
    End If ' 原代码缺少此End If
End Sub

核心问题 #

• 在UserForm_Initialize()中初始化saveditems_lstbox1和saveditems_lstbox2数组会清除已保存的值；不初始化则触发数组越界错误。
• 尝试用以下函数检测数组是否初始化，返回结果始终为False：

Public Function IsArrayInitialized(arr() As Variant) As Boolean
    On Error Resume Next
    Dim dummy As Variant
    dummy = arr(LBound(arr))
    IsArrayInitialized = (Err.Number = 0)
    On Error GoTo 0
End Function

解决方案 #

1. 迁移存储变量到标准模块 #

用户窗体的私有数组在窗体销毁时会被释放，无法持久化数据。需将数组声明移到标准模块（如Module1）中：

' 标准模块Module1中的代码
Public saveditems_lstbox1() As Variant
Public saveditems_lstbox2() As Variant

同时删除用户窗体中原来的Private saveditems_lstbox1() As Variant和Private saveditems_lstbox2() As Variant声明。

2. 修正数组初始化检测函数 #

原函数通过LBound()判断易出错，改用UBound()结合错误捕获更可靠：

Private Function IsArrayInitialized(arr() As Variant) As Boolean
    On Error Resume Next
    Dim temp As Long
    temp = UBound(arr)
    IsArrayInitialized = (Err.Number = 0)
    On Error GoTo 0
End Function

3. 完善窗体事件逻辑 #

• 确保关闭时保存数据：在UserForm_Terminate()事件中调用SaveItems()，保证窗体关闭时自动保存状态：

Private Sub UserForm_Terminate()
    SaveItems
End Sub

• 修正初始化逻辑：修复原代码中变量名错误（last_row_B误用），并正确调用加载函数：

Private Sub UserForm_Initialize()
    Dim Arr
    Dim last_row_A As Long
    
    If Not IsArrayInitialized(saveditems_lstbox1) Then
        last_row_A = Cells(Rows.Count, "A").End(xlUp).Row
        Arr = Range("A1:A" & last_row_A)
        ListBox1.List() = Arr
    Else
        LoadSavedItems
    End If
End Sub

4. 优化SaveItems()的空列表处理 #

当列表框为空时，用Erase重置数组，避免后续检测错误：

Private Sub SaveItems()
    Dim i As Long
    
    ' 处理ListBox1
    If ListBox1.ListCount <> 0 Then
        ReDim saveditems_lstbox1(ListBox1.ListCount - 1)
        For i = 0 To ListBox1.ListCount - 1
            saveditems_lstbox1(i) = ListBox1.List(i)
        Next i
    Else
        Erase saveditems_lstbox1
    End If
    
    ' 处理ListBox2
    If ListBox2.ListCount <> 0 Then
        ReDim saveditems_lstbox2(ListBox2.ListCount - 1)
        For i = 0 To ListBox2.ListCount - 1
            saveditems_lstbox2(i) = ListBox2.List(i)
        Next i
    Else
        Erase saveditems_lstbox2
    End If
End Sub

5. 调整LoadSavedItems()的判断逻辑 #

使用修正后的IsArrayInitialized()函数替代IsEmpty()：

Private Sub LoadSavedItems()
    Dim i As Long
    
    If IsArrayInitialized(saveditems_lstbox1) Then
        ListBox1.Clear
        For i = LBound(saveditems_lstbox1) To UBound(saveditems_lstbox1)
            ListBox1.AddItem saveditems_lstbox1(i)
        Next i
    End If
    
    If IsArrayInitialized(saveditems_lstbox2) Then
        ListBox2.Clear
        For i = LBound(saveditems_lstbox2) To UBound(saveditems_lstbox2)
            ListBox2.AddItem saveditems_lstbox2(i)
        Next i
    End If
End Sub

内容的提问来源于stack exchange，提问作者Keyser Soze