已工作三年的数组上的 LBound 和 UBound 下标超出范围答案

【问题标题】：LBound and UBound Subscript out of range on an array that has worked for three years已工作三年的数组上的 LBound 和 UBound 下标超出范围
【发布时间】：2017-03-03 16:43:50
【问题描述】：

我有四个几乎相同，今天早上他们都工作了，现在他们没有了。

我真的很茫然。唯一不同的是我以外的人在运行它。

代码停在First = LBound(list) 将鼠标悬停在第一个上面显示“First = 0” 在LBound(list) 上面写着“LBound(list)= <Subscript out of range>” 最后是“Last = 0” 在UBound(list) 上显示“UBound(list = <Subscript out of range>”

Option Explicit
Private Sub Workbook_Open()

ActiveSheet.Unprotect Password:="Operator"

MsgBox "This will compile all the operator rounds in the Fire Pump Folder. Enjoy!" & vbNewLine & "Make Sure Your Macros Are Enabled."

Dim fPATH As String, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet
Dim fileNames() As String, i As Long


Set wsDEST = ThisWorkbook.Sheets("Summary")
NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1

fPATH = "\\SMRT01-FPS-15\plant_information\Operator_Required_Rounds\FirePump\"       'remember the final \ in this string

fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath
i = 0
Do While Len(fNAME) > 0
        ReDim Preserve fileNames(i)
        fileNames(i) = fNAME
        i = i + 1
        fNAME = Dir
    Loop

If i >= 0 Then

    BubbleSort fileNames
    For i = 0 To UBound(fileNames)
        Set wbGRP = Workbooks.Open(fPATH & fileNames(i))   'open the file
        LR = wbGRP.Sheets("Fire Pump (Monday)").Range("B" & Rows.Count).End(xlUp).Row  'how many rows of info?
    If LR > 3 Then
        wsDEST.Range("A" & NR) = Replace(Range("A1"), "Group ", "")
        wbGRP.Sheets("Fire Pump (Monday)").Range("B3:F" & LR).Copy
        wsDEST.Range("B" & NR).PasteSpecial xlPasteAll
        NR = wsDEST.Range("B" & Rows.Count).End(xlUp).Row + 1
    End If

    wbGRP.Close False   'close data workbook
Next

Range("A3:A" & NR - 1).SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
With Range("A3:A" & NR - 1)
    .Value = .Value
End With
 Else

        'fileNames array is empty
        MsgBox "No .xls files found in " & fPATH
End If

End Sub
Sub BubbleSort(list() As String)
'   Sorts an array using bubble sort algorithm
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim Temp

    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                 Temp = list(j)
                list(j) = list(i)
                list(i) = Temp
            End If
        Next j
    Next i
End Sub

【问题讨论】：

您是否尝试过将您的 BubbleSort() 代码直接移动到 Workbook_Open 中以查看是否存在解析问题？
我对它实际完成的工作有一个非常基本的了解，因为它是由其他人编写的。
我试图移动它，但我认为我遗漏了一些东西。
BubbleSort 只是按升序对解析到它的数组进行排序。 fileNames 数组默认按升序排列，无需对其进行排序。注释掉该行，您的 Workbook_Open 应该可以正常运行。

标签： arrays vba excel

【解决方案1】：

问题出在 BubbleSort 声明中：

Sub BubbleSort(list() As String)

这就是说将 list() 视为字符串类型变量，而数组通常是 Variant 类型。一个 Variant 可以保存一个字符串或一个字符串数组 - 一个字符串永远不能保存一个数组，因此不会有一个 Ubound。

将 BubbleSort 声明更改为：

Sub BubbleSort(list as Variant)

会起作用的！

也就是说，使用Dir 读入的fileNames() 数组的元素无论如何都会按升序排列。在这种情况下，对 fileNames() 进行排序毫无用处，并且在每次循环通过时对它们进行排序可能会使您的循环不知不觉地变慢。

如果您仍想使用 BubbleSort，请将其移至进入循环之前，以便它只被调用一次。

【讨论】：

【解决方案2】：

根据您的问题描述和代码逻辑，我认为您的问题是
fNAME = Dir(fPATH & "*.xls")
正在返回一个空字符串。

来自 Excel 的内置帮助：

Dir 返回与路径名匹配的第一个文件名。得到任何与路径名匹配的其他文件名，再次调用 Dir 没有论据。当没有更多文件名匹配时，Dir 返回零长度细绳（””）。返回零长度字符串后，您必须指定后续调用中的路径名或发生错误。

虽然文档没有明确说明使用不存在的路径名调用 Dir 将返回一个空字符串，但短语“没有更多文件名匹配”暗示了这一点。

因此，数组fileNames 处于无维度状态。无维度数组将导致您从 LBound 和 UBound 函数观察到的错误。由于错误的代码逻辑，BubbleSort 被调用而没有任何排序。

更改以下语句：

i = 0
Do While Len(fNAME) > 0
   ReDim Preserve fileNames(i)
   fileNames(i) = fNAME
   i = i + 1
   fNAME = Dir
Loop

到：

fNAME = Dir(fPATH & "*.xls")        'get the first filename in fpath
i = -1
Do While Len(fNAME) > 0
   i = i + 1
   ReDim Preserve fileNames(i)
   fileNames(i) = fNAME
   fNAME = Dir
Loop

这将允许代码逻辑的其余部分正常运行，因为如果在评估以下语句时未找到任何文件，变量 i 将为 -1。
If i >= 0 Then

【讨论】：