激活存储在数组中的文件的窗口,但是下标超出范围错误? [英] Activate windows of files stored in arrays, but getting subscript out of range error?

查看:101
本文介绍了激活存储在数组中的文件的窗口,但是下标超出范围错误?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

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 with mid(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 to Workbooks(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 want WORKBOOKS(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. Try Set LastRow = LastRow.Offset(1, 0)

      Range("LastRow").Select更改为LastRow.select

      Windows(的所有实例都应更改为Workbooks(

      All instances of Windows( should be changed to Workbooks(

      这篇关于激活存储在数组中的文件的窗口,但是下标超出范围错误?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆