Excel VBA下标超出范围

Question

我想从每个单元格中取出一个字符串，将它拆分成数组，然后决定添加多少个点，然后添加并显示它们。然而，我一直想出一个下标超出范围的错误，我认为它与拆分语句有关，所以我修改了几次，仍然没有得到任何地方。我也认为，也许这不是分裂，也许在那个单元中没有任何东西，但是（ElseIf数组=“”那么）应该照顾到这一点。这里是我的代码：

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”。

Answer 1

每当您的内部循环获取空单元格时，都会收到下标超出范围的错误。下面的代码是你的代码的上述工作版本：

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 

注：停止进一步研究时，发现行中的任意空单元格。它继续在那种情况下的下一行。

Answer 2

你可以尝试这种方法，其中包括通过删除选择语句稍微整理一下。

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