2016-02-24 56 views
0

我已經建立Excel宏這需要從所有XLS文件所述第一片材的選擇的文件夾(包括在任何子文件夾XLS文件)和複製在紙張到單張紙上在一個新的工作簿。該代碼似乎大部分工作正常,我打算用它來將數千個Excel工作表合併到一個文件中。Excel的循環停止工作

然而,問題是循環剛停止工作,在某些時候,沒有出現的錯誤。有時候它有幾百個文件,有時甚至更多。但這個過程似乎是不可靠的,我不知道爲什麼。

這是我的代碼(我稱之爲合併宏這反過來又調用DoFolder分):

Sub Merge() 
    Dim FileSystem As Object 
    Dim HostFolder As String 
    HostFolder = "C:\XLSfiles" 
    Set FileSystem = CreateObject("Scripting.FileSystemObject") 
    DoFolder FileSystem.GetFolder(HostFolder) 
End Sub 
Sub DoFolder(Folder) 
    Dim unusedRow As Long 'used for writing the file path info before each copied sheet 
    Dim path As String, ThisWB As String, lngFilecounter As Long 
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet 
    Dim Filename As String, Wkb As Workbook 
    Dim CopyRng As Range, Dest As Range 
    Dim RowofCopySheet As Integer 
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from 
    ThisWB = ActiveWorkbook.Name 
    Set shtDest = ActiveWorkbook.Sheets(1) 
    Dim SubFolder 
     For Each SubFolder In Folder.SubFolders 
     DoFolder SubFolder 
    Next 
    Dim File 
    ActiveWindow.WindowState = xlMinimized 
    For Each File In Folder.Files 
     ' Operate on each file 
     unusedRow = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row 
     If Not Filename = ThisWB Then 
      Set Wkb = Workbooks.Open(File) 
      Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1),Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) 
      Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1) 
      CopyRng.Copy Dest 
      Wkb.Close False 
     End If 
     Cells(unusedRow, 1) = File 
     Application.StatusBar = File 
    Next 
    Range("A1").Select 
End Sub 

我缺少什麼?

+0

從你的描述,我覺得你只是達到一個什麼樣的工作表中可以容納的極限;這個限制是1,048,576行16,384列。 您希望實現的是什麼_exactly_?對我來說,這聽起來像是一個數據庫而不是Excel表單的情況? – LocEngineer

+0

我不認爲情況會如此。每個XLS文件不超過50行數據,不超過30-40列。所以最多應該是幾十萬行,不要超過500K。 – Mario

+0

至於確切的目的,是從幾千Excel文件的第一張合併成一個單一的Excel文件。因此,舉例來說,如果我有2000的Excel文件,每個文件有50行數據,我的最終結果將是一個Excel 2000×50 = 10萬行數據文件。 – Mario

回答

0

試試這個:

  1. 而不是複製的範圍,你可以簡單地設置自己的價值
  2. 多張工作時,不要使用Cells;總是明確地陳述對象/片,其細胞您談談

樣品爲我工作:

For Each fi In f.Files 
    If InStr(1, Right(fi.Name, 5), ".xls") > 0 Then 

     Set Wkb = Workbooks.Open(fi) 
     Set ws = Wkb.Sheets(1) 

     rowCount = ws.UsedRange.Rows.Count 
     colCount = ws.UsedRange.Columns.Count 

     ranString = shtDest.Cells(curRow, 1).Address & ":" & shtDest.Cells(curRow + rowCount, colCount).Address 
     Set ran = ws.Range(ws.Cells(2, 1).Address, ws.Cells(rowCount, colCount).Address) 
     Set destRan = shtDest.Range(ranString) 
     destRan.Value = ran.Value 
     curRow = curRow + rowCount 

     Wkb.Close False 
    End If 
Next fi 

它可能看起來有點囉嗦首先建立一個範圍的字符串,但它使調試更輕鬆。