Come posso unire centinaia di file di fogli di calcolo Excel?

Ho centinaia di file Excel che sono tutti dello stesso formato (ovvero 4 fogli di lavoro per file Excel). Ho bisogno di combinare tutti i file in 1 tutti i file di canto e ballo che devono avere lo stesso formato degli originali (ovvero mantenere i quattro fogli di lavoro separati, che sono tutti identicamente nominati).

Mentre ogni file è strutturato allo stesso modo, il numero di colonne (e i nomi delle intestazioni) tra il foglio 1 e 2 (ad esempio) è diverso. Quindi non può essere combinato in un file con tutto in un foglio!

Ci sono due complicazioni:

1. Devo creare una colonna EXTRA nel file unito (su OGNI foglio) per identificare il file sorgente ("nome file").

2. I file contengono molte voci di dati zero (ad es. 55 righe di dati utili seguite da centinaia di righe di zeri) che devo rimuovere dal file unito.

Non ho mai usato VBA, ma tutti devono iniziare da qualche parte suppongo.

Questa è una potente richiesta che hai, ma ho avuto una serata da masterizzare, quindi ecco un codice che penso funzionerà. (Non conoscere i formati dei tuoi fogli non aiuta, ma possiamo lavorare da questo.)

Apri una nuova cartella di lavoro (questa sarà la tua cartella di lavoro principale), vai nell'ambiente VBA (Alt + F11) e crea un nuovo modulo (Inserisci> Modulo). Incolla il seguente codice VBA nella finestra del nuovo modulo:

Option Explicit
Const NUMBER_OF_SHEETS = 4

Public Sub GiantMerge()
    Dim externWorkbookFilepath As Variant
    Dim externWorkbook As Workbook
    Dim i As Long
    Dim mainLastEnd(1 To NUMBER_OF_SHEETS) As Range
    Dim mainCurEnd As Range

    Application.ScreenUpdating = False

    ' Initialise

    ' Correct number of sheets
    Application.DisplayAlerts = False
    If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
        ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
    ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
        For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
            ThisWorkbook.Sheets(i).Delete
        Next i
    End If
    Application.DisplayAlerts = True

    For i = 1 To NUMBER_OF_SHEETS
        Set mainLastEnd(i) = GetTrueEnd(ThisWorkbook.Sheets(i))
    Next i


    ' Load the data
    For Each externWorkbookFilepath In GetWorkbooks()
        Set externWorkbook = Application.Workbooks.Open(externWorkbookFilepath, , True)

        For i = 1 To NUMBER_OF_SHEETS

            If mainLastEnd(i).Row > 1 Then
                ' There is data in the sheet

                ' Copy new data (skip headings)
                externWorkbook.Sheets(i).Range("A2:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i))
            Else
                ' No nata in sheet yet (prob very first run)

                ' Get correct sheet name from first file we check
                ThisWorkbook.Sheets(i).Name = externWorkbook.Sheets(i).Name

                ' Copy new data (with headings)
                externWorkbook.Sheets(i).Range("A1:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i)).Offset(, 1)

                ' Add file name heading
                ThisWorkbook.Sheets(i).Cells(1, mainCurEnd.Column).Value = "File Name"
            End If

            ' Add file name into extra column
            ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, mainCurEnd.Column), mainCurEnd).Value = externWorkbook.Name

            Set mainLastEnd(i) = mainCurEnd
        Next i

        externWorkbook.Close
    Next externWorkbookFilepath

    Application.ScreenUpdating = True
End Sub

' Returns a collection of file paths, or an empty collection if the user selects cancel
Private Function GetWorkbooks() As Collection
    Dim fileNames As Variant
    Dim xlFile As Variant

    Set GetWorkbooks = New Collection

    fileNames = Application.GetOpenFilename(Title:="Please choose the files to merge", _
                                               FileFilter:="Excel Files, *.xls;*.xlsx", _
                                               MultiSelect:=True)
    If TypeName(fileNames) = "Variant()" Then
        For Each xlFile In fileNames
            GetWorkbooks.Add xlFile
        Next xlFile
    End If
End Function

' Finds the true end of the table (excluding unused columns/rows and rows filled with 0's)
Private Function GetTrueEnd(ws As Worksheet) As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long
    Dim c As Long

    On Error Resume Next
    lastCol = ws.UsedRange.Find("*", , , xlPart, xlByColumns, xlPrevious).Column
    lastRow = ws.UsedRange.Find("*", , , xlPart, xlByRows, xlPrevious).Row
    On Error GoTo 0

    If lastCol <> 0 And lastRow <> 0 Then

        ' look back through the last rows of the table, looking for a non-zero value
        For r = lastRow To 1 Step -1
            For c = 1 To lastCol
                If ws.Cells(r, c).Text <> "" Then
                    If ws.Cells(r, c).Text <> 0 Then
                        Set GetTrueEnd = ws.Cells(r, lastCol)
                        Exit Function
                    End If
                End If
            Next c
        Next r
    End If

    Set GetTrueEnd = ws.Cells(1, 1)
End Function

Salvalo e siamo pronti per iniziare ad usarlo.

Esegui la macro GiantMerge. Devi selezionare i file Excel che desideri unire (puoi selezionare più file con la finestra di dialogo, nel solito modo Windows (Ctrl per selezionare più singoli file, Maiusc per selezionare un intervallo di file)). Non è necessario eseguire la macro su tutti i file che si desidera unire, è possibile eseguirne solo alcuni alla volta. La prima volta che lo eseguirai, configurerai la tua cartella di lavoro principale in modo che abbia il numero corretto di fogli, assegna un nome ai fogli in base alla prima cartella di lavoro che hai selezionato per unire e aggiungi le intestazioni.

Ho formulato i seguenti presupposti (non un elenco completo):

• Ci sono 4 fogli (questo può essere facilmente modificato cambiando la costante all'inizio del codice.)
• I fogli sono nello stesso ordine in tutte le cartelle di lavoro extra
• Le colonne di ciascun foglio sono nello stesso ordine in tutte le cartelle di lavoro (sebbene non tutti i fogli di una cartella di lavoro abbiano le stesse colonne. Ad esempio, Quaderno1, Foglio1 ha le colonne A, B, C, Foglio2 ha le colonne A, B; Libro degli esercizi2, Foglio1 ha le colonne A, B, C, Foglio2 ha le colonne A, B. Ecc. Se una cartella di lavoro ha quanto segue: Foglio1 ha colonne A, C, B, Foglio2 ha colonne B, A, le colonne non saranno allineate correttamente)
• Non ci sono colonne extra o mancanti nelle cartelle di lavoro extra
• C'è una riga di intestazione in ogni foglio in ogni cartella di lavoro (ed è nella prima riga solo su ciascun foglio)
• Tutte le colonne dovrebbero essere incluse (anche se contengono solo 0)
• Tutte le righe alla fine di una tabella contenente solo 0 non vengono copiate nel master
• È solo il nome del file (e non il percorso del file) necessario nella colonna aggiuntiva
• Non so quanto funzionerà se non disponi di dati in alcuni fogli (o sono solo pieni di zeri)

Spero che questo ti aiuti.

Vale anche la pena ricordare che Ron de Bruin ha creato un favoloso plugin per Windows per unire fogli di lavoro Excel, chiamato RDBMerge. Le istruzioni sono disponibili qui: http://www.rondebruin.nl/merge.htm . Ha funzionato perfettamente per me, unendo i file xlsx in Excel 2007.

Crea una colonna aggiuntiva nel file unito contenente il nome del file di origine. Non sono sicuro di come gestisca zero voci di dati (seconda parte della domanda originale).

Se hai bisogno di uno strumento solo per unire quei file Excel, dai un'occhiata a JMC Excel .

Questo è un progetto di dimensioni decenti, ma molto fattibile. Ecco un buon inizio su VBA su cui puoi basarti. Ciò ti consentirà di esaminare tutti i file che devi unire se li hai (da solo) in una cartella. La cartella di lavoro principale in cui stai unendo NON dovrebbe trovarsi in questa directory.

Option Explicit
Sub giantmerge()
    Dim f As Object, fso As Object
    Dim folder As String
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim sn1 As String, sn2 As String, sn3 As String, sn4 As String
    Set wb = ThisWorkbook
    'Change sheet names to match those in your workbooks.
    sn1 = "Sheet1"
    sn2 = "Sheet2"
    sn3 = "Sheet3"
    sn4 = "Sheet4"
    Set ws1 = wb.Sheets(sn1)
    Set ws2 = wb.Sheets(sn2)
    Set ws3 = wb.Sheets(sn3)
    Set ws4 = wb.Sheets(sn4)

    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Cancel Selected"
            End
        End If
        folder = .SelectedItems(1)
    End With
    For Each f In fso.GetFolder(folder).Files
        Workbooks.Open Filename:=f.Path
        'Get data and store in temporary arrays.
        Workbooks(f.Name).Close
        'Input data in this workbook (master).
    Next
End Sub

Ora, tu (o qualcun altro) puoi fornire il codice per il ciclo For alla fine. Spero che questo ti aiuti.

Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    ' change folder path of excel files here
    Set dirObj = mergeObj.Getfolder("D:\change\to\excel\files\path\here")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)

        ' change "A2" with cell reference of start point for every files here
        ' for example "B3:IV" to merge all files start from columns B and rows 3 
        ' If you're files using more than IV column, change it to the latest column
        ' Also change "A" column on "A65536" to the same column as start point
        Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate

        ' Do not change the following column. It's not the same column as above
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close
    Next
End Sub

Metodo usando un semplice script Python (molto più breve di VB!).

https://superuser.com/a/1138948/141182