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