Excel VBA subscript out of range

Question

各セルの文字列を配列に分割し、追加するポイント数を決定して追加して表示しようとしています。しかし、私はスプリットステートメントと何か関係があると思ったので、私はそれを何度か改訂したが、まだどこにも手を出さなかった。私はまた、分割されていないかもしれないと思っていたかもしれませんし、そのセルには何もなかったかもしれませんが、（ElseIf配列= "" 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」です。

Answer 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 

注：行内の空のセルが見つかると、さらに見えるようになります。その場合、次の行に進みます。

Answer 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