VBA UserForm点击New按钮打开窗体时出现“Subscript out of range”错误

我是VBA新手，正在创建一个UserForm，用户可通过ListBox查看表格信息。窗体设有New、Edit、Delete和Close按钮，点击New按钮时返回“Subscript out of range”错误，调试指向buttonNovo_Click事件中的frm.Show语句。尝试过修改窗体名称、直接调用formNovo.Show等方法，均未解决问题，以下是完整代码及代码结构截图：

代码结构截图 #

完整代码 #

modMain #

Option Explicit

Public Sub Main()

    Dim frm As New formRegistro
    frm.Show
    Set frm = Nothing
    
End Sub

modRange #

Option Explicit

Public ws As Worksheet

Public Function GetRange() As Range
    Set ws = ActiveWorkbook.Worksheets("Registro")
    Set GetRange = ws.Range("A1").CurrentRegion
    Set GetRange = GetRange.Offset(1).Resize(GetRange.Rows.Count - 1)
End Function

Public Sub deleterow(ByVal row As Long)
    Set ws = ActiveWorkbook.Worksheets("Registro")
    ws.Range("A2").Offset(row).EntireRow.Delete
End Sub

Public Function GetNewID() As Long
    GetNewID = 1 + WorksheetFunction.Max(ws.Range("A2").CurrentRegion.Columns(1))
End Function

Public Function GetTurno() As Variant
    Dim wo As Worksheet
    Set wo = ActiveWorkbook.Worksheets("Oculto")
    GetTurno = ws.ListObjects("tbTurno").DataBodyRange.Value
End Function

formRegistro #

Option Explicit

Private Sub buttonClose_Click()
    Unload Me
End Sub

Private Sub buttonNovo_Click()
    Dim frm As New formNovo
    frm.Show
End Sub

Private Sub buttonEdit_Click()
    Dim frm As New formAtt
    frm.Show
End Sub

Private Sub buttonDelete_Click()
    Call deleterow(listRegistro.ListIndex)
End Sub

Private Sub UserForm_Initialize()
    Call AddDataToListBox
End Sub

Public Sub AddDataToListBox()
    Dim rg As Range
    Set rg = GetRange()
    
    With listRegistro
        .RowSource = rg.Address(external:=True)
        .ColumnCount = rg.Columns.Count
        .ColumnWidths = "65,2 pt;97,8 pt;97,8 pt;130,4 pt;130,4 pt;65,2 pt;163 pt"
        .ColumnHeads = True
        .ListIndex = 0
    End With
End Sub

formNovo #

Option Explicit

Private Sub buttonFechar_Click()
    Unload Me
End Sub

Private Sub buttonSalvar_Click()
    
    If MsgBox("Deseja salvar dados?", vbYesNo, "Save Record") = vbYes Then
        'Escrever dados dos controles ao banco de dados
        Call WriteDataToSheet
    
        'Limpar as caixas de texto
        Call EmptyTextBoxes
    
        'Criar um novo ID
        Call CreateID
        
    End If
    
End Sub

Private Sub WriteDataToSheet()

    Set ws = ActiveWorkbook.Worksheets("Registro")
    Dim newRow As Integer
    
    With ws
        newRow = .Cells(.Rows.Count, 1).End(xlUp).Rows + 1
        newRow = newRow + 1
        .Cells(newRow, 1).Value = txtID.Value
        .Cells(newRow, 2).Value = txtData.Value
        .Cells(newRow, 3).Value = txtHora.Value
        .Cells(newRow, 4).Value = txtCarga.Value
        .Cells(newRow, 5).Value = txtPlaca.Value
        .Cells(newRow, 6).Value = comboboxTurno.Value
        .Cells(newRow, 7).Value = txtRespons.Value
    End With
End Sub

Private Sub EmptyTextBoxes()
    Dim c As Control
    For Each c In Me.Controls
        If TypeName(c) = "TextBox" Then
            c.Value = ""
        End If
    Next c
End Sub


Private Sub UserForm_Initialize()

    'criar ID
    Call CreateID
    'iniciar controle
    Call InitializeControls
    
End Sub

Private Sub CreateID()
    Me.txtID.Value = GetNewID()
End Sub

Private Sub InitializeControls()
    Me.comboboxTurno.List = GetTurno()
    Me.comboboxTurno.ListIndex = 0
    
End Sub

错误原因及修复方案 #

1. 核心错误：GetTurno函数对象引用错误 #

modRange中的GetTurno函数里，你定义了wo指向"Oculto"工作表，但实际调用ListObject时错误使用了全局变量ws（指向"Registro"工作表），导致找不到名为tbTurno的ListObject，触发下标越界错误。

修复代码：

Public Function GetTurno() As Variant
    Dim wo As Worksheet
    Set wo = ActiveWorkbook.Worksheets("Oculto")
    GetTurno = wo.ListObjects("tbTurno").DataBodyRange.Value
End Function

2. GetNewID函数依赖全局变量风险 #

GetNewID使用全局ws变量，若ws未初始化（比如首次打开formNovo时未调用过GetRange），会导致访问Range出错。同时需处理空表场景，避免Max函数报错。

修复代码：

Public Function GetNewID() As Long
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("Registro")
    ' 处理空表，避免Max函数报错
    If ws.Range("A2").Value = "" Then
        GetNewID = 1
    Else
        GetNewID = 1 + WorksheetFunction.Max(ws.Range("A2").CurrentRegion.Columns(1))
    End If
End Function

3. WriteDataToSheet中行号计算错误 #

原代码中newRow = .Cells(.Rows.Count, 1).End(xlUp).Rows + 1是错误的（应该用.Row而非.Rows），且重复加1会导致空行。

修复代码：

Private Sub WriteDataToSheet()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("Registro")
    Dim newRow As Long
    
    With ws
        newRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(newRow, 1).Value = txtID.Value
        .Cells(newRow, 2).Value = txtData.Value
        .Cells(newRow, 3).Value = txtHora.Value
        .Cells(newRow, 4).Value = txtCarga.Value
        .Cells(newRow, 5).Value = txtPlaca.Value
        .Cells(newRow, 6).Value = comboboxTurno.Value
        .Cells(newRow, 7).Value = txtRespons.Value
    End With
End Sub

4. 优化建议 #

尽量避免使用全局变量（如Public ws As Worksheet），在每个需要的过程中局部声明并初始化工作表对象，减少因变量状态异常导致的错误。

内容的提问来源于stack exchange，提问作者Lucas Kanda