范围误差下标- VBA误差

Question

我一直被下标超出了以下代码的范围，我对VBA很陌生，因此非常感谢您的帮助。

我试图引用一个包含各种源工作簿的表，并将数据从这里复制到sTable范围中也包含的“目标”工作簿。

谢谢你，罗南

Sub Import()
    Dim sTable As String                              ' Source table
    Dim sTarget As String                             ' Target range for output
    Dim sHeader As String                             ' Header row from the input data
    Dim sFileName As String                           ' File name to read from
    Dim tFileName As String
    Dim sInputSheet As String                         ' Worksheet to read from
    Dim sRange As String                              ' Range to read from/copy
    Dim tSheet As String
    Dim tRange As String                              ' Range to paste into/Target Range
    Dim sRow As Integer
    Dim cRow As Integer

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False

    'Define source(s) and target(t) sheets
    sTable = "rng_SourceData"
    'loop through source table to copy and paste requred data
    sRow = Range(sTable).Rows.Count

    For cRow = 1 To sRow
    'loop through source table to copy and paste requred data
    sRow = Range(sTable).Rows.Count
    For cRow = 1 To sRow


        sFileName = Worksheets("I.Import").Range(sTable).Cells(cRow, 1)
        sInputSheet = Worksheets("I.Import").Range(sTable).Cells(cRow, 2)
        sRange = Worksheets("I.Import").Range(sTable).Cells(cRow, 3)
        tFileName = Worksheets("I.Import").Range(sTable).Cells(cRow, 4)
        tRange = Worksheets("I.Import").Range(sTable).Cells(cRow, 5)
        tSheet = Worksheets("I.Import").Range(sTable).Cells(cRow, 6)

        'Include all ranges in the input table
        Call ImportDataSpreadsheet(sFileName, sInputSheet, sRange, tSheet, tRange)


    Next cRow

End Sub

Sub ImportDataSpreadsheet(sFileName, sInputSheet, sRange, tSheet, tRange)
    Dim SourceWorkbook As Excel.Workbook
    Dim TargetWorkbook As Excel.Workbook
    Dim TargetSheet As Excel.Worksheet

    'Define Source workbook
    Set SourceWorkbook = Workbooks.Open(Filename:=sFileName, Password:=False)
    'Select.Workbook.Sheets.Open (sInputSheet)
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False

    'Copy
    SourceWorkbook.Sheets(sInputSheet).Activate
    SourceWorkbook.Sheets(sInputSheet).EnableSelection = xlNoRestrictions

    SourceWorkbook.Sheets(sInputSheet).Range(sRange).Copy

    'Define Target workbook
    Set TargetWorkbook = ThisWorkbook.Worksheets("I.Import").Range(sTable).Cells(cRow, 4)
    Set TargetSheet = TargetWorkbook.Sheets(tSheet)

    'Paste
    TargetWorkbook.Sheets(tSheet).Range(tRange).PasteSpecial Paste:=xlPasteValues

    'Close and finish.
    SourceWorkbook.Close savechanges:=False

End Sub

Answer 1

造成这个问题的原因是，当您Open一个新的工作簿时，您正在更改什么是ActiveWorkbook，您的代码默认使用ActiveWorkbook，因为您没有限定您的Worksheets集合来说明它们真正引用的是哪个工作簿。

解决这个问题的最简单方法是创建一个引用，当您启动代码时，工作簿是活动的：

'Define source(s) and target(t) sheets
sTable = "rng_SourceData"

Dim wbTable As Workbook
Set wbTable = ActiveWorkbook

'Shorten some code by using a With block
With wbTable.Worksheets("I.Import").Range(sTable)
    'loop through source table to copy and paste requred data
    sRow = .Rows.Count
    For cRow = 1 To sRow

        sFileName = .Cells(cRow, 1)
        sInputSheet = .Cells(cRow, 2)
        sRange = .Cells(cRow, 3)
        tFileName = .Cells(cRow, 4)
        tRange = .Cells(cRow, 5)
        tSheet = .Cells(cRow, 6)

        'Include all ranges in the input table
        ImportDataSpreadsheet sFileName, sInputSheet, sRange, tSheet, tRange

    Next cRow
End With

因为代码现在总是引用wbTable，它是在打开任何其他工作簿之前设置的，所以代码将引用正确的工作表。

注意:理论上，我们并不真的需要wbTable，我们只需要一个

With ActiveWorkbook.Worksheets("I.Import").Range(sTable)

块，但我个人倾向于将其设置为临时对象。