VBA 拆分Excel中的各sheet为文件

发布于:2024-05-05 ⋅ 阅读:(27) ⋅ 点赞:(0)

一. 方式1

  • xlOpenXMLWorkbook.xlsx格式的文件
  • xlWorkbookDefault:当前Excel的格式(当前Excel是什么格式,被拆分出的sheet页所生成的文件就是什么格式)
  • "\":可以使用Application.PathSeparator代替
Sub 拆分工作表()
    
    ' 初始化变量
    Dim sheetObj As Worksheet
    Dim MyBook As Workbook
    Set MyBook = ActiveWorkbook
    
    ' 循环Excel中的所有sheet页
    For Each sheetObj In MyBook.Sheets
        ' 复制当前sheet页
        sheetObj.Copy
        ' 根据sheet名称创建文件,并且指定新创建的文件类型是 .xlsx
        ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sheetObj.Name, FileFormat:=xlOpenXMLWorkbook
        ' 关闭新创建的工作簿
        ActiveWorkbook.Close
    Next
    
    ' 弹出对话框,提示处理完毕
    MsgBox "文件已经被拆分完毕!"
    
End Sub

二. 方式2

  • sht.Visible:判断sheet页是否可见
    • -1xlSheetVisible(工作表可见)
    • 0xlSheetHidden(工作表隐藏,但可以通过工作表选项卡显示)
    • 2xlSheetVeryHidden(工作表隐藏,并且在工作表选项卡中不可见)
  • With Application.FileDialog(msoFileDialogFolderPicker):用于显示文件夹选择对话框的语句
    • msoFileDialogOpen:打开文件对话框,用于选择要打开的文件。
    • msoFileDialogSaveAs:另存为文件对话框,用于选择保存文件的路径和文件名。
    • msoFileDialogFilePicker:文件选择对话框,允许选择一个或多个文件。
    • msoFileDialogFolderPicker:文件夹选择对话框,用于选择文件夹路径。
  • Right(strPath, 1):获取右侧第一个字符
  • VBA中的For Each没有类似于contiune的语法,只能使用IF Else来处理跳过
Sub EachShtToWorkbook()

    Dim sht As Worksheet
    Dim strPath As String
    Dim visibilityStatus As Integer
    
    ' 选择保存工作薄的文件路径
    With Application.FileDialog(msoFileDialogFolderPicker)
    
        ' 读取选择的文件路径,如果用户未选取路径则退出程序
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
        
    End With
    
    ' 如果路径中没有分隔符的话,就给加上分隔符
    If Right(strPath, 1) <> Application.PathSeparator Then
        strPath = strPath & Application.PathSeparator
    End If
    
    ' 取消显示系统警告和消息,避免重名工作簿无法保存。当有重名工作簿时,会直接覆盖保存。
    Application.DisplayAlerts = False
    ' 取消屏幕刷新
    Application.ScreenUpdating = False
    
    ' 遍历工作表
    For Each sht In Worksheets
        
        ' 判断当前sheet是否被隐藏
        visibilityStatus = sht.Visible
        
        ' xlSheetVisible: -1(工作表可见)
        ' xlSheetHidden: 0(工作表隐藏,但可以通过工作表选项卡显示)
        ' xlSheetVeryHidden: 2(工作表隐藏,并且在工作表选项卡中不可见)
        If visibilityStatus <> xlSheetHidden And visibilityStatus <> xlSheetVeryHidden Then
            ' 复制工作表,工作表单纯复制后,会成为活动工作薄
            sht.Copy
            With ActiveWorkbook
                ' 保存活动工作薄到指定路径下,以当前系统默认文件格式
                .SaveAs strPath & sht.Name, xlWorkbookDefault
                ' 关闭工作薄并保存
                .Close True
            End With
        End If
        
    Next
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    ' 恢复显示系统警告和消息
    Application.DisplayAlerts = True
    
    MsgBox "处理完成。", , "提醒"
    
End Sub