遍历vba内容定义的范围以查找特定值，下标错误

Question

我正在用Excel创建的一个相当开放的测试中尝试一种新方法。当前，VBA将贯穿我的源工作表（请参阅questionCount，getLastAnsRow和lastrow），并将仅关注那些单元格。然后，我试图将这些值传递给checkAnswers子对象，以便它将遍历该范围，检查sheet2上的答案，然后输出1或0。我感觉自己在做一些显而易见的事情，但我却迷失了方向。

Option Explicit

Sub Q1()
    Dim i As Integer
    Dim ws1 As Worksheet
    Dim answerRows(0 To 500) As Variant
    Dim ansRowEnd As Long

    Set ws1 = Worksheets("PracticalAlpha")
    With ws1
        For i = 0 To questionCount(ws1, answerRows) - 1
            ansRowEnd = getLastAnsRow(ws1, answerRows(i))
            Call checkAnswers(ws1, answerRows(i) + 1, ansRowEnd)
        Next
    End With
End Sub

checkAnswers

Public Sub checkAnswers(ws As Worksheet, ansRowStart As Long, ansRowEnd As Long)
    Dim i As Integer
    Dim j As Integer
    Dim counter As Integer
    Dim keyWords As Variant
    Dim phrase As Variant
    Dim phraseCount As Integer
    ReDim check1(ansRowStart To ansRowEnd) As Boolean

    Call questionCount

    If ansRowStart > ansRowEnd Then ansRowStart = ansRowEnd

    With ws

        For i = ansRowStart To ansRowEnd

                For j = ansRowStart To ansRowEnd

        If .Cells(ansRowStart - 1, 1).Value <> "phrase test" And Not IsNumeric(.Cells(ansRowStart - 1, 1).Value) Then

                    If (.Cells(i + counter, 2) = Sheet2.Cells(j + counter,2))Then
                    check1(i) = True
                    Exit For

                    Else: check1(i) = False

                    End If
                    'counter = counter + 1

            Next
        Next

        j = 0

            For i = LBound(check1) To UBound(check1)

                If check1(i) = True Then j = j + 1

                Next

                If j = questionCount Then
                .Cells(ansRowStart, 6) = 1

                Else: .Cells(ansRowStart, 6) = 0

        ElseIf .Cells(ansRowStart, 1).Value = "phrase test" Then
            keyWords = Split(Sheet2.Cells(ansRowStart, 2).Value, "' '")
            For Each phrase In keyWords
                keyWords(phraseCount) = LCase(Replace(keyWords(phraseCount), "'", ""))
                If InStr(.Cells(ansRowStart, 2).Value, keyWords(phraseCount)) = 0 Then
                    .Cells(ansRowStart, 6) = 0
                    Exit Sub
                End If
                phraseCount = phraseCount + 1
            Next phrase
            .Cells(ansRowStart, 6) = 1
        End If
    End With
End Sub

getLastAnsRow

Private Function getLastAnsRow(ws As Worksheet, num As Variant)
    Dim i As Integer

    For i = num To 500
        If ws.Cells(i, 2).Value = "*****" Then
            getLastAnsRow = i - 1
            If getLastAnsRow < i Then getLastAnsRow = i
            Exit Function
        End If
    Next i
End Function

最后一刻

Public Function lastrow(ws As Worksheet, colNum As Integer) As Long
    Dim i As Long
    Dim emptyCount As Long

    With ws
        For i = 1 To 10000
            If .Cells(i, 2).Value = "" Then
                emptyCount = emptyCount + 1
            Else
                emptyCount = 0
            End If
            If emptyCount = 100 Then
                lastrow = i - emptyCount
                Exit Function
            End If
        Next i
    End With
End Function

questionCount

Private Function questionCount(ws As Worksheet, answerRows As Variant) As Long
    Dim i As Long
    Dim j As Integer

    For i = 1 To lastrow(ws, 1)
        If IsNumeric(ws.Cells(i, 1).Value) And ws.Cells(i, 1).Value <> "" Then
            questionCount = questionCount + 1
            answerRows(j) = i + 1
            j = j + 1
        End If
    Next i
End Function