arrays - 工作表数组下标超出范围

Question

我正在创建一个宏，它将从较大的工作簿中选择工作表，移动这些工作表并将其保存为新工作簿，然后移至下一组工作表。

我创建了一个带有开始值和结束值(由工作表索引号指定)的伪“数组”。

在完成保存文件的部分后，但在拉下一组工作表的循环之前，我遇到了“下标超出范围”错误。

下面是我的代码。任何有关此错误的帮助将不胜感激。

Dim Start As Integer
Dim Finish As Integer
Dim SR As Integer  
Dim SC As Integer
Dim ER As Integer
Dim EC As Integer
SR = 2
SC = 5
ER = 2
EC = 6
Start = Sheets("REF").Cells(SR, SC).Value
Finish = Sheets("REF").Cells(ER, EC).Value
Dim sheetArray() As Double
Dim i As Integer
Dim c As Integer
i = 0
c = Start
lastrow = Cells(100, SC).End(xlUp).Row

Do Until SR = lastrow

    Do Until c > Finish
        ReDim Preserve sheetarray (0 to i)
        i = i + 1
        c = c + 1
    Loop

    Sheets(sheetarray).Copy
    ActiveWorkbook.SaveAs Filename:= _ XXXXXXXXXXXXXXXXXX

    C = Start
    i = 0
    SR = SR + 1
    ER = ER + 1
Loop

编辑:16:35 美国中部

目前，相关代码块通过 lastrow = Cells(100, SC).End(xlUp).Row 行与上面的内容匹配

执行直到 SR = Lastrow

ReDim sheetArray(i)

Do Until c > Finish
    ReDim Preserve sheetArray(i)
    sheetArray(i) = c
    i = i + 1
    c = c + 1

Loop



Sheets(sheetArray).Copy
ActiveWorkbook.SaveAs Filename:= _
    XXXXXXXXXXXXX

c = Start
i = 0
SR = SR + 1
ER = ER + 1

循环

Answer 1

这里您需要三件事:

1. 在加载每个工作表索引之前重新调整数组，因为按照现在的方式，它只会在每个循环上继续构建，因此从第二个循环开始，您将收到 Subscript out of range 错误- 因为数组基本上具有，例如，首先是 1 3 5，然后是 1 3 5 3 7，其中 1 3 5 来自首先，然后从第二个开始 3 7。
2. 每次设置数组的值。您只需设置数组的元素
3. 限定要从中复制工作表的工作簿，因为每次复制工作表时，都会将事件工作簿设置为新复制的工作簿。

像这样构建您的 Do Loop block :

Do Until SR = lastrow

    ReDim sheetArray(0) 'or you can put i here since you set it to zero at the bottom

    Do Until c > Finish

        ReDim Preserve sheetArray(i)
        sheetArray(i) = c

        i = i + 1
        c = c + 1

    Loop

    Workbooks("myWkb").Sheets(sheetArray).Copy 'where myWkb is the workbook name you need ... you can also use ThisWorkbook (meaning the workbook where the code is running) but this is not best practice
    ActiveWorkbook.SaveAs Filename:="XXXXXXXXXXXXXXXXXX"

    c = Start
    i = 0
    SR = SR + 1
    ER = ER + 1

Loop