Arrays Excel中的VBA用户定义函数，用于在循环中断开意外的大值

更新-进一步测试后，我看到UniqueLength的值变为2^（X-1）+1，其中X是结果数。我还是不明白为什么会这样

我有一个函数，用户可以在Excel的一行（以预定格式和特定列）上输入，名为ScoreQ2（）。该函数从B列中获取一个ID，搜索该ID所在的B列的每一行，并检查这些行是否符合条件。最终，它会返回一个分数（你不必理解，但这是在评分）

它适用于大多数项，但由于某些原因，它会在一些较大的值上中断。具体来说，它在3个ID上断开，这些ID的行数最多，符合标准（“2-红色化学…”）和单元格（i，24）=200。数据集大约有13K行，这些ID在该集中有21、15或11个响应

在我的代码中，您将看到我声明了一个从1到5000的数组。我不知道为什么我需要超过21个。当我将数组大小从500更改为5000时，包含13个响应的ID开始工作。再加上0到50000，15个响应项就可以工作了。然而，没有可接受的数组大小可以处理21个响应（我一直添加0，直到它崩溃）

我意识到我在这里做了一些非常奇怪的事情，比如声明数组的前19个值。出于某种原因，我不得不申报一些，而这就是我最终的结局

我试着用一个21号ID的设置示例来逐步完成。它最终在“Unique（UniqueLength）=Cells（I，23）”上出现错误9，下标超出范围。这就是为什么我想到将数组大小从500增加到5000

我可以在这里发布几个例子，但我不确定如何发布，或者是否有必要。如果有帮助，请告诉我

Function ScoreQ2()

Dim Max As Integer
Dim Min As Integer
Dim Unique(1 To 5000) As Integer
Dim UniqueLength As Integer
Dim NewUnique As Boolean
Dim LastRow As Integer
Dim ResultID As Long
Dim question As Long


ResultID = 0
UniqueLength = 1
NewUnique = True
Max = 0
Min = 200
question = 0
Unique(1) = 500
Unique(2) = 500
Unique(3) = 500
Unique(4) = 500
Unique(5) = 500
Unique(6) = 500
Unique(7) = 500
Unique(8) = 500
Unique(9) = 500
Unique(10) = 500
Unique(11) = 500
Unique(12) = 500
Unique(13) = 500
Unique(14) = 500
Unique(15) = 500
Unique(16) = 500
Unique(17) = 500
Unique(18) = 500
Unique(19) = 500


LastRow = Application.Caller.Worksheet.UsedRange.Rows.Count

For i = 1 To LastRow
    If Cells(i, 2) = Cells(Application.Caller.Row, Application.Caller.Column - 15) Then
    ResultID = ResultID + 1
        If StrComp(Cells(i, 11), "2 - Red Chemical_Reduced Range") = 0 Then
        question = question + 1

        If Cells(i, 24) = 200 Then
            NewUnique = True
            For j = 1 To UniqueLength
                If Cells(i, 23) = Unique(j) Then
                NewUnique = False
                j = UniqueLength
                End If

                If NewUnique = True Then
                Unique(UniqueLength) = Cells(i, 23)
                UniqueLength = UniqueLength + 1

                    If Cells(i, 23) > Max Then
                    Max = Cells(i, 23)
                    End If

                    If Cells(i, 23) < Min Then
                    Min = Cells(i, 23)
                    End If

                End If
           Next j
        Else
        End If
    Else

    End If
Else
End If
Next i

If UniqueLength > 3 Then
If Max - Min > 99 Then
    ScoreQ2 = 3
Else
    ScoreQ2 = 2
End If
ElseIf UniqueLength > 2 Then
ScoreQ2 = 1

Else
ScoreQ2 = 0
End If


End Function

函数ScoreQ2（）
将最大值调整为整数
将最小值设置为整数
Dim Unique（1到5000）为整数
Dim UniqueLength为整数
Dim NewUnique作为布尔值
将最后一行设置为整数
暗淡的结果和长的一样
模糊的问题
ResultID=0
唯一长度=1
NewUnique=True
最大值=0
最小值=200
问题=0
唯一（1）=500
唯一（2）=500
唯一（3）=500
唯一（4）=500
唯一（5）=500
唯一（6）=500
唯一（7）=500
唯一（8）=500
唯一（9）=500
唯一（10）=500
唯一（11）=500
唯一（12）=500
唯一（13）=500
唯一（14）=500
唯一（15）=500
唯一（16）=500
唯一（17）=500
唯一（18）=500
唯一（19）=500
LastRow=Application.Caller.Worksheet.UsedRange.Rows.Count
对于i=1到最后一行
如果单元格（i，2）=单元格（Application.Caller.Row，Application.Caller.Column-15），则
ResultID=ResultID+1
如果StrComp（单元格（i，11），“2-红色化学物质减少范围”）=0，则
问题=问题+1
如果单元格（i，24）=200，则
NewUnique=True
对于j=1到唯一长度
如果单元格（i，23）=唯一（j），则
NewUnique=False
j=唯一长度
如果结束
如果NewUnique=True，则
唯一（唯一长度）=单元格（i，23）
唯一长度=唯一长度+1
如果单元格（i，23）>最大值，则
最大值=单元（i，23）
如果结束
如果单元（i，23）3，则
如果最大最小值>99，则
分数Q2=3
其他的
分数Q2=2
如果结束
如果唯一长度大于2，则
分数Q2=1
其他的
分数Q2=0
如果结束
端函数

我不知道您到底想做什么，但问题在于您的循环构造

（i，24）=200的第一次for循环是

For j = 1 To 1

并且仅运行一次，值为UniqueLength=1

如果条件

  If Cells(i, 23) = Unique(1) 

如果计算结果为false，则将向UniqueLength添加1，因此现在为2

下一次你有for循环的时候

For j = 1 To 2

唯一长度的值为2

然后检查

If Cells(i, 23) = Unique(1) and then runs again and checks if it is Unique(2).

如果这两个值都不是真的（而且永远不会是真的，因为您将唯一数组的前19项设置为500，这可能不是一个可能的值），那么您将增加两次UniqueLength，使其现在为4

下一次，您的for循环是

For j = 1 To 4

您将使UniqueLength增加4

这会导致UniqueLength=2^X的行为

至于如何解决这个问题，还不清楚你想做什么，所以我不知道该说什么

首先，必须在数组中声明值的原因是，第一次启动时，数组为空

然后对阵列运行检查：

If Cells(i, 23) = Unique(j)

但唯一（1）是空的

您需要修复查看阵列的方式。（注意：可能有更好的方法，但这是我能想到的最快的修复方法） 将ws设置为工作表 设置ws=Sheets（“mySheet”） 唯一长度=0

....more code (do not declare the array values)

If ws.Cells(i, 24) = 200 Then
        NewUnique = True
        For j = 1 To UniqueLength 'When 0, this will not run the loop
            If ws.Cells(i, 23) = Unique(j) Then
                NewUnique = False
                Exit For
            End If
        Next j

        If NewUnique = True Then
            UniqueLength = UniqueLength + 1
            Unique(UniqueLength) = ws.Cells(i, 23)

.....rest of code

---

显然，您需要在设置分数的末尾修复该部分，我不确定您到底想做什么，但这至少会在没有指数循环的情况下运行。

对于初学者，始终使用

Long

作为行计数器，非

Integer

。如果此代码位于常规模块中，则每当您单独使用

Cells（）

时，它将默认为活动工作表，因此如果带有公式的工作表不活动，它将返回错误信息。您是指UniqueLength吗？我试过了，但没有改变。我对这一切感到困惑的一部分是，唯一长度永远不应该真正超过反应的范围。所以，对于21个回答，它不应该高于21。蒂姆，我能做些什么来解决这个问题吗？也就是说，我不确定我在这里是否遇到过这种情况。谢谢。另一个建议是将行“j=UniqueLength”改为“Exit For”，因为它更清晰。这