excel - Excel 宏错误 9 - 下标超出范围 - 运行时出错但单步执行时出错 (f8)

Question

我编写了一个 VBA 代码来逐步选择超链接并从每个文件中获取数据。

在第二次通过循环时（当我运行宏时），我得到一个错误 9 - 下标超出范围。当我通过 F8 按钮单步执行宏时，它运行良好。

我在运行时进行了调试，并且 Range(x.Address) 具有正确的单元格地址。如果我为第一个条目失败的行运行代码，它就可以工作。

它只是在第二次运行时失败。

Sub HistoricRevData()

On Error GoTo MHSErrorHandler:

Dim WB_MonthlyLoad As Object
Dim WB_ProjectSummary As Object
Dim WS_MonthSht As Object
Dim WS_PerComSht As Object
Dim WS_PriceSht As Object
Dim WS_RevSht As Object
Dim varLastCol As Integer
Dim varRowCount As Integer

'save the MonthlyLoad book as an object for easy reference
Set WB_MonthlyLoad = ActiveWorkbook
Set WS_MonthSht = ActiveSheet
Set WS_PriceSht = WB_MonthlyLoad.Sheets("Price")
Set WS_RevSht = WB_MonthlyLoad.Sheets("Revenue")
varRowCount = 2

'Open the Project Summary Report and save as object
'  - Note right now this just does the single project need to loop through all
'
For Each x In Selection.Cells

    If x.Value <> "" Then
        Range(x.Address).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        Worksheets("% Complete").Select
        Set WB_ProjectSummary = ActiveWorkbook
        Set WS_PerComSht = WB_ProjectSummary.Worksheets("% Complete")
        WB_MonthlyLoad.Activate
        varLastCol = WS_PerComSht.Rows(5).Find(What:="Total", LookIn:=xlFormulas).Column - 2

        WS_PriceSht.Cells(varRowCount, 1).Value = WS_PerComSht.Cells(7, 1).Value
        WS_PerComSht.Range(WS_PerComSht.Cells(8, 4), WS_PerComSht.Cells(8, varLastCol)).Copy
        WS_PriceSht.Cells(varRowCount, 2).PasteSpecial Paste:=xlPasteValues

        WS_RevSht.Cells(varRowCount, 1).Value = WS_PerComSht.Cells(7, 1).Value
        WS_PerComSht.Range(WS_PerComSht.Cells(41, 4), WS_PerComSht.Cells(41, varLastCol)).Copy
        WS_RevSht.Cells(varRowCount, 2).PasteSpecial Paste:=xlPasteValues

        varRowCount = varRowCount + 1
    End If

MHSDate:
    WB_ProjectSummary.Close savechanges:=False

MHSLink:
     Next x

Exit Sub

'==========================================================================================
MHSErrorHandler:

MsgBox (Err.Description & " - " & Err.Number & x.Address)

If Err.Description = "Cannot open the specified file." Then
    Err.Clear
    Resume MHSLink
End If

If Err.Number = 91 Then
        Err.Clear
        WS_MonthSht.Cells(x.Row, 6).Value = "On % Comp, Couldn't find Total Column"
        Resume MHSDate
End If

'===============================================================================================

End Sub

有人有想法么

标签： excelvbasubscript