激活存储在数组中的文件的窗口,但是下标超出范围错误? [英] Activate windows of files stored in arrays, but getting subscript out of range error?
问题描述
Sub Merge()
Dim File As String
Dim AllFiles(), Filename As Variant
Dim count, test, StartRow, LastRow, LastColumn As Long
Dim LastCell As Variant
test = 0
ChDir "C:\" 'Insert suitable directory for your computer ex:ChDir "C:\Users\Jerry Hou\" if file of interest is in "Jerry Hou" Folder
ReDim AllFiles(1)
Do
Application.EnableCancelKey = xlDisabled
File = Application.GetOpenFilename("XML Files (*.xml),*.xml", 1, "Select File to be Merged") 'Needs to select in Order to merge files
Application.EnableCancelKey = xlErrorHandler
If (File = "False") Then Exit Do
ReDim Preserve AllFiles(count) 'Preserve ?
AllFiles(count) = File 'File== file name and directory
count = (count + 1)
If (MsgBox("Select Another File To be Merged With?", vbQuestion + vbOKCancel, "Merge Files") = vbCancel) Then Exit Do
Loop 'Select Cancel in MsgBox to finish merge file(s) selection
If (count = 0) Then
MsgBox "No selection" 'If you hit Exit from open prompt window
Exit Sub
End If
For count = 0 To UBound(AllFiles)
MsgBox "User selected file name: " & AllFiles(count)
Next
test = count
For test = UBound(AllFiles) To LBound(AllFiles) Step -1
Workbooks.Open Filename:=AllFiles(test)
Next
ReDim AllFiles(count)
test = 2
Do While (test <= count)
Filename = AllFiles(test)
Workbooks(AllFiles(test)).Activate 'ERROR Brings 2nd file that the user had selected to Last xml file selected in order to Front
'Copy and Paste TMG tab
Sheets("TMG_4 0").Activate
StartRow = 2
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCell = Cells(LastRow, LastColumn).Address 'Find lastcell of to be copied file
Range("A2:" & LastCell).Select
Selection.Copy
Windows("Allfiles(1).xml").Activate 'ERROR
Sheets("TMG_4 0").Activate
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = LastRow + 1
Range("LastRow").Select 'ERROR
ActiveSheet.Paste
'Copy and Paste Gamma tab
Sheets("GammaCPS 0").Activate
StartRow = 2
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastCell = Cells(LastRow, LastColumn).Address
Range("A2:" & LastCell).Select
Selection.Copy
Windows("Allfiles(1).xml").Activate 'ERROR Windows("File_name.xlsm").activate
Sheets("GammaCPS 0").Activate
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = LastRow + 1
Range("LastRow").Select 'ERROR
ActiveSheet.Paste
test = test + 1
Loop
Windows("Allfiles(1).xml").Activate 'ERROR
ActiveWorkbook.SaveAs Filename:="C:\" & AllFiles(1) & AllFiles(test) & ".xlsm", FileFormat:=52
结束子
推荐答案
- 您可以重命名AllFiles,但切勿填充任何东西.是否缺少代码?
- AllFiles是一个基于0的数组,因此,如果要从第二个元素开始,则需要使用test = 1而不是test = 2.
-
要遍历数组,请尝试以下操作:
- You redim AllFiles but never fill it with anything. Is there missing code?
- AllFiles is a 0 based array so if you want to start at the second element you need to use test = 1 instead of test = 2.
For looping through an array, try this:
For test = 1 to ubound(AllFiles) - 1 'This loops through the array from the second element to the last
"LastRow"是一个命名范围吗?如果没有,那是行不通的.下面将选择工作表中最后使用的行:
Is "LastRow" a named range? If not, that's not going to work. The following will select the last used row in a worksheet:
activesheet.Rows(activesheet.usedrange.rows.count).select
您的SaveAs失败,因为1)AllFiles看起来好像从来没有被填充过; 2)您编写的保存路径实际上是:
C:\Allfile(1)&Allfiles(count)\.xlsm
.您想要:Your SaveAs is failing because 1) AllFiles looks like it's never filled and 2) your save path as you wrote would be literally:
C:\Allfile(1)&Allfiles(count)\.xlsm
. You want:ActiveWorkbook.SaveAs Filename:= "C:\" & AllFiles(1) & AllFiles(test) & ".xlsm"
代码更新后进行编辑
-
您永远不会初始化计数变量,只是为了安全起见,请在开头添加
count = 0
.
GetOpenFilename
确实返回了完整路径.一旦将该路径存储在变量(例如AllFiles())中,就可以使用mid(AllFiles(test), instrrev(AllFiles(test), "\") + 1)
GetOpenFilename
does in fact return the full path. Once you have that path stored in a variable (such as AllFiles()) you can get just the filename portion withmid(AllFiles(test), instrrev(AllFiles(test), "\") + 1)
在执行主Do Loop之前不需要
ReDim AllFiles(count)
.除非您使用Preserve关键字,否则ReDim会擦除数组的内容.You don't need the
ReDim AllFiles(count)
prior to your main Do Loop. ReDim erases the contents of the array unless you use the Preserve keyword.将
Workbooks(AllFiles(test)).Activate
更改为Workbooks(Mid(AllFiles(test), InStrRev(AllFiles(test), "\") + 1)).Activate
以剥离路径信息,仅保留文件名.Change
Workbooks(AllFiles(test)).Activate
toWorkbooks(Mid(AllFiles(test), InStrRev(AllFiles(test), "\") + 1)).Activate
to strip the path information and leave just the filename.Windows("Allfiles(1).xml").Activate
由于您发送文字字符串而无法正常工作.您要再次在这里WORKBOOKS(Mid(AllFiles(1), InStrRev(AllFiles(1), "\") + 1)).Activate
.Windows("Allfiles(1).xml").Activate
won't work since your sending a literal string. You wantWORKBOOKS(Mid(AllFiles(1), InStrRev(AllFiles(1), "\") + 1)).Activate
here again.LastRow = LastRow + 1
可能不是您的意思.尝试Set LastRow = LastRow.Offset(1, 0)
LastRow = LastRow + 1
probably isn't what you meant. TrySet LastRow = LastRow.Offset(1, 0)
将
Range("LastRow").Select
更改为LastRow.select
Windows(
的所有实例都应更改为Workbooks(
All instances of
Windows(
should be changed toWorkbooks(
这篇关于激活存储在数组中的文件的窗口,但是下标超出范围错误?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
-