在VBA中的ReDim上的下标超出范围(错误9)

时间:2015-01-30 03:27:01

标签: excel vba excel-vba

尝试在“Shifts”课程中创建新成员时出错。该子目的是填充以下变量(在类的顶部声明):

Private ShiftMembers() As String
Private ShiftCallSigns() As String
Private ShiftAssignments() As String
Private ShiftStatuses() As String

Public Sub AddMember(ByVal Name As String, ByVal CallSign As String, ByVal Assignment As String, Optional ByVal Status As String)
  If IsEmpty(ShiftMembers) = False Then
    ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
    ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
    ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
    ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

  Else
    ReDim Preserve ShiftMembers(0)
    ReDim Preserve ShiftCallSigns(0)
    ReDim Preserve ShiftAssignments(0)
    ReDim Preserve ShiftStatuses(0)
  End If


  ShiftMembers(UBound(ShiftMembers)) = Name
  ShiftCallSigns(UBound(ShiftCallSigns)) = CallSign
  ShiftAssignments(UBound(ShiftAssignments)) = Assignment
  ShiftStatuses(UBound(ShiftStatuses)) = Status
End Sub

当我调用此Sub时,我收到“下标超出范围(错误9)”消息。有任何想法吗?谢谢!我创建了“IsEmpty()”检查,因为我相信如果数组有0个元素,UBound会抛出错误(对吗?)。

提前致谢!

-Rob

2 个答案:

答案 0 :(得分:0)

问题在于以下几点:

ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

在未定义边界时访问,因此UBound会引发错误。 IsEmtpy不会检查数组边界,如果您在0显式声明边界,那么您将无法ReDim

要解决此问题,您可以单独跟踪初始化:

Private ShiftMembers() As String
Private ShiftCallSigns() As String
Private ShiftAssignments() As String
Private ShiftStatuses() As String
Private IsInitialized As Boolean

Public Sub AddMember(ByVal Name As String, ByVal CallSign As String, ByVal Assignment As String, Optional ByVal Status As String)
  If IsInitialized Then
    ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
    ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
    ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
    ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

  Else
    ' Preserve isn't really needed here.
    ReDim Preserve ShiftMembers(0)
    ReDim Preserve ShiftCallSigns(0)
    ReDim Preserve ShiftAssignments(0)
    ReDim Preserve ShiftStatuses(0)
    IsInitialized = True
  End If


  ShiftMembers(UBound(ShiftMembers)) = Name
  ShiftCallSigns(UBound(ShiftCallSigns)) = CallSign
  ShiftAssignments(UBound(ShiftAssignments)) = Assignment
  ShiftStatuses(UBound(ShiftStatuses)) = Status
End Sub

在上面,我使用了IsInitialized变量(默认为False),然后在首次定义数组边界后显式设置它True

答案 1 :(得分:0)

Sub M_snb()
  On Error Resume Next
  y = UBound(shiftmembers)
  If Err.Number <> 0 Then y = -1

  ReDim Preserve shiftmembers(y + 1)
End Sub