Question

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

我真的很茫然。唯一不同的是，除了我以外的其他人经营它。

代码在First = LBound(list)处停止将鼠标悬停在第一位，它会读取＆＃34; First = 0＆＃34; 超过LBound(list)它会读取＆＃34; LBound(list)= <Subscript out of range>＆＃34; 在最后它读取＆＃34; Last = 0＆＃34; 超过UBound(list)，它会读取＆＃34; UBound(list = <Subscript out of range>＆＃34;

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

Answer 1

问题在于BubbleSort声明：

Sub BubbleSort(list() As String)

将list（）视为String类型变量，而数组通常是Variant类型。 Variant可以包含一个String或一个字符串数组 - 一个String永远不会拥有一个数组，因此不会有Ubound。

将BubbleSort声明更改为：

Sub BubbleSort(list as Variant)

会奏效！

也就是说，使用Dir读取的fileNames（）数组的元素无论如何都将按升序排列。排序fileNames（）在此上下文中没有用处，并且在每个循环传递上对它们进行排序可能会使您的循环不知不觉地变慢。

如果您仍想使用BubbleSort，请在进入循环之前将其移至该位置，以便仅调用一次。

Answer 2

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

来自Excel的内置帮助：

Dir返回与路径名匹配的第一个文件名。得到任何与路径名匹配的其他文件名，再次使用no调用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

LBound和UBound下标超出了已经工作了三年的阵列

2 个答案: