Активировать окна файлов, хранящихся в массивах, но вывести индекс из-за ошибки диапазона? - PullRequest
Новая
       27

Активировать окна файлов, хранящихся в массивах, но вывести индекс из-за ошибки диапазона?

0 голосов
/ 22 августа 2011 
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

End Sub

1 Ответ

0 голосов
/ 22 августа 2011
  • Вы переделываете AllFiles, но никогда ничего не заполняете. Отсутствует ли код?
  • AllFiles - это массив на основе 0, поэтому, если вы хотите начать со второго элемента, вам нужно использовать test = 1 вместо test = 2.

  • Для циклического перебора массива попробуйте следующее:

    For test = 1 to ubound(AllFiles) - 1 'This loops through the array from the second element to the last

  • Является ли "LastRow" именованным диапазоном? Если нет, то это не сработает. Следующее выберет последнюю использованную строку на листе:

    activesheet.Rows(activesheet.usedrange.rows.count).select

  • Ваш SaveAs не работает, потому что 1) AllFiles выглядит так, как будто он никогда не заполнен, и 2) ваш путь сохранения, как вы написали, будет буквально: C:\Allfile(1)&Allfiles(count)\.xlsm. Вы хотите:

    ActiveWorkbook.SaveAs Filename:= "C:\" & AllFiles(1) & AllFiles(test) & ".xlsm"

РЕДАКТИРОВАТЬ после обновления кода

  • Вы никогда не инициализируете переменную count, добавьте count = 0 в начало, чтобы быть в безопасности.

  • GetOpenFilename фактически возвращает полный путь. Как только вы сохраните этот путь в переменной (например, AllFiles ()), вы можете получить только часть имени файла с помощью mid(AllFiles(test), instrrev(AllFiles(test), "\") + 1)

  • Вам не нужно ReDim AllFiles(count) до основного цикла Do Loop. ReDim стирает содержимое массива, если вы не используете ключевое слово Preserve.

  • Измените Workbooks(AllFiles(test)).Activate на Workbooks(Mid(AllFiles(test), InStrRev(AllFiles(test), "\") + 1)).Activate, чтобы убрать информацию о пути и оставить только имя файла.

  • Windows("Allfiles(1).xml").Activate не будет работать с момента отправки литеральной строки. Вы хотите WORKBOOKS(Mid(AllFiles(1), InStrRev(AllFiles(1), "\") + 1)).Activate здесь снова.

  • LastRow = LastRow + 1 вероятно, не то, что вы имели в виду. Попробуйте Set LastRow = LastRow.Offset(1, 0)

  • Изменить Range("LastRow").Select на LastRow.select

  • Все экземпляры Windows( следует изменить на Workbooks(

...