将 Excel 工作表另存为单独的文件并在文件夹中循环答案

【问题标题】：Saving Excel worksheets as separate files and looping through folder将 Excel 工作表另存为单独的文件并在文件夹中循环
【发布时间】：2021-06-30 09:16:23
【问题描述】：

如何将文件夹中的所有 Excel 文件分成单独的工作表？

所有文件都有两张表，称为结果和数据点。

我在 Excel 中使用 VBA。

Sub LoopThroughFilesAndSplit()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xlsm*")
        NewFileName = Left(xFileName, Len(xFileName) - 5)
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                Dim FPath As String
                FPath = Application.ActiveWorkbook.Path
                Application.ScreenUpdating = False
                Application.DisplayAlerts = False
                For Each ws In ThisWorkbook.Sheets
                    ws.Copy
                    Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & NewFileName & "-" & ws.Name & ".xlsx"
                    Application.ActiveWorkbook.Close False
                Next
                Application.DisplayAlerts = True
                Application.ScreenUpdating = True
            End With
            xFileName = Dir
        Loop
    End If
End Sub

它只在我将代码放入的工作表上工作，而不是在文件夹中循环。

如果有人知道如何在 Python 中做到这一点，那就是我想学习的平台。我找不到任何用于此目的的模板。

【问题讨论】：

在使用 Python 进行操作之前，建议先确定以哪种方式（win32com.client (COM)、Python Excel libraries ...）以及应该在哪个操作系统中完成

标签： python python-3.x excel vba

【解决方案1】：

试试这个 VBA 代码

Option Explicit

Sub LoopThroughFilesAndSplit()
    Dim xFd As FileDialog, xFdItem As Variant, xFileName As String, NewFileName As String, ws As Object
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xlsm*")
        Do While xFileName <> ""
            NewFileName = Left(xFileName, Len(xFileName) - 5) 'move inside loop
            With Workbooks.Open(xFdItem & xFileName)
                For Each ws In .Sheets  'remove ThisWorkbook so will be used `With Workbooks.Open`
                    ws.Copy
                    ActiveWorkbook.SaveAs Filename:=.Path & "\" & NewFileName & "-" & ws.Name & ".xlsx"
                    ActiveWorkbook.Close False
                Next
                .Close False    'close opened `With Workbooks.Open`
            End With
            xFileName = Dir
        Loop
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If
End Sub

【讨论】：