[英]sheet array subscript out of range
我正在创建一个宏,它将从较大的工作簿中选择工作表,将这些工作表移动并保存为新的工作簿,然后转到下一组。
我创建了一个带有开始和结束值的伪“数组”(由工作表索引号指定)。
我在完成保存文件的部分之后遇到“下标超出范围”错误,但是在循环之前会拉出下一组工作表。
以下是我的代码。 任何有关此错误的帮助将不胜感激。
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
你需要三件事:
Subscript out of range
错误 - 因为数组基本上有,作为一个例子首先是1 3 5
,然后是1 3 5 3 7
,首先是1 3 5
,第二是3 7
。 像这样构建你的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
正如我所看到的,问题在于你只是在调整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)数组,因为它的元素是工作表的索引......但是,即使有双精度数,它也应该可以正常设置数组的内容。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.