Excel VBA下标超出范围

我想从每个单元格中取出一个string，将它分解到数组中，然后决定添加多less个点，然后添加并显示它们。 然而，我不断提出一个下标超出范围的错误，我认为这是与拆分语句有关，所以我修改了几次，仍然没有得到任何地方。 我也认为，也许这不是分裂，也许在那个单元中没有任何东西，但（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 

另外，应该在单元格中的string的格式是“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 

注意：当它在一行中find任何空的单元格时，它会停下来看。 这种情况继续下一行。

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