Question

我正在开发一个数千行的程序，它收集/生成一堆数据文件，所有数据文件都有不同的格式，然后收集（制表）一部分数据并进行一些分析。

该计划几周前工作正常。现在，尽管没有触及它，但是两个连续的测试运行和两个逐步调试会话已经无限地落在i = lbound（...）到ubound（...）....下一个i循环。相关代码转载如下。

显示的函数只是循环遍历一个二维数组（通过为变量分配一个范围而创建），用于字符串LIKE一维数组中的字符串。导致错误的范围是238x33。然而，＆＃34; row＆＃34;索引＆＃34;我＆＃34;到达44，然后重置为0，而不是增加到45甚至更高。此外，当发生这种情况时，相反的字符串来自＆＃34; * example *＆＃34; to＆＃34; **例**＆＃34;，每次＆＃34; i＆＃34;每一边都增加星号的数量。计数器重置为0。

我最好的猜测是存在某种名称/参考冲突。但是，为什么这只是现在出现，并且把它说出来，似乎有点超出我的想法。

功能定义：

Function arrayFirstLike(ByRef dataArr As Variant, ByVal fieldArr As Variant, _ 
Optional ByVal byRows As Boolean = True, Optional ByVal exactSearch As Boolean = False) As Variant

致电：

Set infowb = addSaveTemplate(rootPath & templatesPath & "\yFcstIndexInfo", rootPath & countryInfoPath & "\matureMarketFcst")
Set datawb = Workbooks.Open(rootPath & countryPath & "\spdjFcst", updateLinks:=False, ReadOnly:=True)
dataArr = datawb.Worksheets("ESTIMATES&PEs").UsedRange.Value
Call closeNoAlerts(datawb)

fieldArr = Array("Data as of the close of", "S&P 500 5YR")
fieldArr2 = arrayFirstLike(dataArr, fieldArr) 'returns 2x3 zero base array of variants

函数体（请注意，这是一个在程序中其他地方成功调用的实用函数：因此，在嵌套循环开始之前，函数参数被重构）：

Dim i As Long, j As Long, k As Long, fieldsFound As Long
Dim tempArr() As Variant

If Not IsArray(fieldArr) Then 'fieldArr is a single string
    fieldArr = Array(fieldArr)
Else
    On Error GoTo skipRedim
    i = LBound(fieldArr, 2)
    On Error GoTo 0

    ReDim tempArr(LBound(fieldArr, 1) To UBound(fieldArr, 1)) As Variant
    For i = LBound(tempArr, 1) To UBound(tempArr, 1)
        tempArr(i) = fieldArr(i, LBound(fieldArr, 2))
    Next i
    fieldArr = tempArr
afterRedim:
End If

If Not exactSearch Then
    For i = LBound(fieldArr, 1) To UBound(fieldArr, 1)
         fieldArr(i) = "*" & fieldArr(i) & "*"
    Next i
End If

ReDim tempArr(LBound(fieldArr, 1) To UBound(fieldArr, 1), 0 To 2) As Variant
fieldsFound = 0

If byRows Then
    For i = LBound(dataArr, 1) To UBound(dataArr, 1) 'rows
        For j = LBound(dataArr, 2) To UBound(dataArr, 2) 'cols
            For k = LBound(fieldArr, 1) To UBound(fieldArr, 1) 'searchlist
                If tempArr(k, 0) = Empty Then 'check for nonoccurance

                    If dataArr(i, j) Like fieldArr(k) Then 'k,1: seach string
                        tempArr(k, 0) = dataArr(i, j): tempArr(k, 1) = i: tempArr(k, 2) = j
                        fieldsFound = fieldsFound + 1
                        Exit For
                    End If

                End If
            Next k
            If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
        Next j
        If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
    Next i
Else
     For j = LBound(dataArr, 2) To UBound(dataArr, 2) 'cols
        For i = LBound(dataArr, 1) To UBound(dataArr, 1) 'rows
            For k = LBound(fieldArr, 1) To UBound(fieldArr, 1)
                If tempArr(k, 1) = Empty Then 'check first occurance

                    If dataArr(i, j) Like fieldArr(k) Then 'k,1: seach string
                        tempArr(k, 0) = dataArr(i, j): tempArr(k, 1) = i: tempArr(k, 2) = j
                        fieldsFound = fieldsFound + 1
                        Exit For
                    End If
                End If
            Next k
            If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
        Next i
        If fieldsFound = UBound(fieldArr, 1) - LBound(fieldArr, 1) + 1 Then Exit For
    Next j
End If

arrayFirstLike = tempArr

Exit Function

skipRedim:
Resume afterRedim

Answer 1

这个怎么样：

On Error GoTo skipRedim
i = LBound(fieldArr, 2)
On Error GoTo 0

如果出现错误，请跳至afterRedim:，因此永远不要执行On Error GoTo 0。这意味着任何后来的错误都将使用相同的错误处理程序，这很容易导致您描述的行为。我会先尝试解决这个问题。

编辑：您可以创建一个函数来检查数组维度 - 请参阅这里的答案中的示例VBA check if array is one dimensional

＆＃39;对于下一个＆＃39;循环重置计数器，然后到达“未结束”状态。导致无限循环...可能的名称/参考冲突？

1 个答案: