表格數組下標超出范圍

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

Loop

Answer 1

你需要三件事：

1. 在加載每個工作表索引之前重新調整數組，因為現在它的方式只會繼續構建在每個循環上，因此從第二個循環開始，你將得到下Subscript out of range錯誤 - 因為數組基本上有，作為一個例子首先是1 3 5 ，然后是1 3 5 3 7 ，首先是1 3 5 ，第二是3 7 。
2. 每次設置數組的值。 您只需設置數組的元素
3. 限定從哪個工作簿復制工作表，因為每次復制工作表時，它都會將活動工作簿設置為新復制的工作簿。

像這樣構建你的Do Loop塊：

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

Answer 2

正如我所看到的，問題在於你只是在調整sheetArray的尺寸，但是你沒有把任何東西放進去。 所以基本上，數組中的值都是零。 然后，您要求Excel復制工作表（0），這超出了范圍，因為工作表編號從1開始。

您可以通過在數組中寫入要復制的工作表的索引來解決此問題：

Do Until c > Finish
    ReDim Preserve sheetarray (0 to i)
    sheetarray(i) = c ' <~~~~ or something else, according to your goal
    i = i + 1
    c = c + 1
Loop

ps：最好使sheetArray成為一個Integer（而不是Double）數組，因為它的元素是工作表的索引......但是，即使有雙精度數，它也應該可以正常設置數組的內容。