Excel VBA 下标超出范围答案

【问题标题】：Excel VBA subscript out of rangeExcel VBA 下标超出范围
【发布时间】：2016-11-08 04:41:47
【问题描述】：

我试图从每个单元格中取出一个字符串，将其拆分为数组，然后决定要添加多少点，然后添加它们并显示它们。然而，我一直想出一个下标超出范围的错误，我认为它与 split 语句有关，所以我对其进行了多次修改，但仍然没有得到任何地方。然后我还想也许这不是分裂，也许那个单元格里什么都没有，但是 (ElseIf array = "" Then) 应该处理好这个问题。这是我的代码：

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100
  Cells(j, 1).Select
  If ActiveCell.Value = "" Then
    j = 100
  Else
    For i = 3 To 22
      Cells(j, i).Select
      pointArray = Split(ActiveCell.Value, ".")

'The next line is where the debugger says the script is out of range
      If pointArray(0) = "Tardy" Then     
        points = 0.5
      ElseIf pointArray(0) = "Failure To Complete Shift" Then
        points = 0.5
      ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
        points = 0.5
      ElseIf pointArray(0) = "Absence" Then
        points = 1
      ElseIf pointArray(0) = "Late Call Off" Then
        points = 2
      ElseIf pointArray(0) = "No Call/No Show" Then
        points = 4
      ElseIf pointArray(0) = "" Then
        i = i + 1
      Else
        MsgBox "Somthing is wrong in Module 1 Points Adding"
      End If

      'Add points to points cell
      Cells(j, 2).Select
      points = points + ActiveCell.Value
      ActiveCell.Value = points
    Next i
  End If
Next j

End Sub

单元格中的字符串格式也是“Occurrence.Description.Person.mm/dd/yyyy”。

【问题讨论】：

在哪一行得到下标超出范围错误？当您收到该错误时单击“调试”按钮，导致错误的行将在您的代码中突出显示。
但是您的 i 循环中也可以有一个空白单元格？
C:V 列中的任何单元格是否为空？如果是这样，当你尝试访问pointArray(0)时会出现下标错误
是的，这就是为什么我有 else if 语句检查的原因。
Lol 好的，所以我正在检查数组是否单元格为空。我应该在拆分单元格中的字符串之前检查一下，然后检查单元格本身。

标签： vba excel

【解决方案1】：

每当你的内部 for 循环得到一个空单元格时，你就会得到一个下标超出范围的错误。以下代码是您上面代码的工作版本：

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100

    Cells(j, 1).Select

    If ActiveCell.Value = "" Then
        j = 100
    Else
        For i = 3 To 22

            Cells(j, i).Select

            Dim Val As String
            Val = ActiveCell.Value

            ' Check if cell value is not empty
            If (Val <> "") Then
                pointArray = Split(ActiveCell.Value, ".", -1)

                'The next line is where the debugger says the script is out of range
                If pointArray(0) = "Tardy" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Failure To Complete Shift" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Absence" Then
                    points = 1
                    ElseIf pointArray(0) = "Late Call Off" Then
                    points = 2
                    ElseIf pointArray(0) = "No Call/No Show" Then
                    points = 4
                    ElseIf pointArray(0) = "" Then
                    i = i + 1
                    Else
                    ' MsgBox "Somthing is wrong in Module 1 Points Adding"

                End If

                'Add points to points cell
                Cells(j, 2).Select
                points = points + ActiveCell.Value
                ActiveCell.Value = points

            Else

                ' A cell was found empty
                i = 23
            End If


        Next i

    End If
Next j

End Sub

注意：当它在一行中找到任何空单元格时，它会停止进一步查看。在这种情况下，它会继续到下一行。

【讨论】：

非常感谢您的帮助！

【解决方案2】：

您可以尝试这种方法，其中包括通过删除 select 语句进行一些整理。

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100
    If Cells(j, 1).Value = "" Then
        exit for
    Else
        For i = 3 To 22
            pointArray = Split(Cells(j, i).Value, ".", -1)

            'The next line is where the debugger says the script is out of range
            If UBound(pointArray) > -1 Then
                If pointArray(0) = "Tardy" Then
                    points = 0.5
                ElseIf pointArray(0) = "Failure To Complete Shift" Then
                    points = 0.5
                ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
                    points = 0.5
                ElseIf pointArray(0) = "Absence" Then
                    points = 1
                ElseIf pointArray(0) = "Late Call Off" Then
                    points = 2
                ElseIf pointArray(0) = "No Call/No Show" Then
                    points = 4
                ElseIf pointArray(0) = "" Then
                    i = i + 1
                Else
                    MsgBox "Somthing is wrong in Module 1 Points Adding"
                End If
            End If
            'Add points to points cell
            points = points + Cells(j, 2).Value
            Cells(j, 2).Value = points
        Next i
    End If
Next j

End Sub

【讨论】：