Excel VBA-Index außerhalb des Bereichs

Question

Ich versuche, eine Zeichenfolge aus jeder Zelle in das Array zu teilen und dann entscheiden, wie viele Punkte hinzuzufügen, dann fügen Sie sie hinzu und zeigen sie an. Allerdings habe ich immer wieder einen Indexfehler außerhalb des Bereichs gefunden, von dem ich dachte, dass er etwas mit der Split-Anweisung zu tun hat, also habe ich ihn mehrmals überarbeitet und immer noch nirgendwo hingekommen. Ich dachte auch, dass es vielleicht nicht der Split war und vielleicht gab es nichts in der Zelle, aber mit dem (ElseIf array = "" Then) hätte das erledigt werden müssen. Hier ist mein Code:

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 

Auch das Format der Zeichenfolge, die in der Zelle sein sollen, ist „Occurrence.Description.Person.mm/dd/yyyy“.

Answer 1

Sie erhalten einen Indexfehler außerhalb des Bereichs, wenn Ihre innere for-Schleife eine leere Zelle erhält. Der folgende Code ist eine funktionierende Version des Codes oben:

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 

Hinweis: Es hört weiter zu suchen, wenn es eine leere Zelle in einer Zeile findet. Es geht in diesem Fall zur nächsten Zeile.

Answer 2

Sie könnten diesen Ansatz versuchen, der ein wenig Aufräumen durch Entfernen von Select-Anweisungen beinhaltet.

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