[VBA]合并Excel文件内容 @ 11/14/2018

技术类
描述:
工作需要,把一堆excel文件(xslx)合并为一个文件。
于是写了一个VB Application。
需要者请自取。


Sub CombineSheets()
    Dim dlgFileDialog As FileDialog
    Set dlgFileDialog = Application.FileDialog(msoFileDialogFilePicker)
   
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add
   
    With dlgFileDialog
        ; 选择多个文件
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls;*.xlsx"
        .Filters.Add "All Files", "*.*"
       
        If .Show = -1 Then
            Dim vrtSelectedItem As Variant
           
            Dim i As Integer
            i = 1

            For Each vrtSelectedItem In .SelectedItems
                Dim tmpWorkbook As Workbook
                Set tmpWorkbook = Workbooks.Open(vrtSelectedItem)

                If tmpWorkbook.Worksheets.Count = 1 Then
                    ;如果源文件里面只有一个Sheet,在新excel文件里面的Sheet名为文件名
                    tmpWorkbook.Worksheets(1).Copy Before:=newWorkbook.Worksheets(i)
                    newWorkbook.Worksheets(i).Name = VBA.Replace(tmpWorkbook.Name, ".xlsx", "")
                    i = i + 1
                ElseIf tmpWorkbook.Worksheets.Count > 1 Then
                    ; 如果源文件里面有多个Sheet,在新excel文件里面的Sheet名为"文件名(第几个Sheet)"
                    Dim tmpWorkSheet As Worksheet
                   
                    Dim j As Integer
                    j = 1
                   
                    For Each tmpWorkSheet In tmpWorkbook.Worksheets
                        tmpWorkSheet.Copy Before:=newWorkbook.Worksheets(i)
                        newWorkbook.Worksheets(i).Name = VBA.Replace(tmpWorkbook.Name, ".xlsx", "(" & j & ")")
                        i = i + 1
                        j = j + 1
                    Next tmpWorkSheet
                End If
                tmpWorkbook.Close SaveChanges:=False
            Next vrtSelectedItem
        End If
    End With

    Set dlgFileDialog = Nothing
End Sub
发布于 11/14/2018 19:01:57 | 评论:0

看帖要回帖...

categories
archives
links
statistics
  • 网志数:1143
  • 评论数:2011