Question

我有两个文件夹作为2015和2016，在每个文件夹中，有12个子文件夹作为月份，每个月文件夹有许多excel文件。例如，从2015文件夹 - ＆gt; 8月15日文件夹 - ＆gt; PC Aug15.xlsb - ＆gt;数据（表单名称）我需要将此工作表导出为CSV并在新路径中保存为Aug15.CSV。

这样我需要8月15日至7月16日的数据。我该怎么做。请帮忙

尝试使用下面的代码，但不知道我是多么精神，我只需要名为“数据”的表格

Sub SaveToCSVs()
    Dim fDir As String
    Dim wB As Workbook
    Dim wS As Worksheet
    Dim fPath As String
    Dim sPath As String
    fPath = "C:\temp\pydev\"
    sPath = "C:\temp\"
    fDir = Dir(fPath)
    Do While (fDir <> "")
        If Right(fDir, 4) = ".xls" Or Right(fDir, 5) = ".xlsx" Then
            On Error Resume Next
            Set wB = Workbooks.Open(fPath & fDir)
            For Each wS In wB.Sheets
                wS.SaveAs sPath & wS.Name, xlCSV
            Next wS
            wB.Close False
            Set wB = Nothing
        End If
        fDir = Dir
        On Error GoTo 0
    Loop
End Sub

Answer 1

我理解您的代码正在从目标文件夹中正确读取所有文件，问题是您只想从每个文件中提取一个名为Sheet的{{1}}，所以如果是这样的话，请尝试这样：

编辑仅包括所选栏目的提取！

方法：复制目标工作表

Data

方法：以只读方式打开工作簿

Sub SaveToCSVs()
Const kWshName As String = "Data"
Dim sPathInp As String, sPathOut As String
Dim sPathFile As String, sCsvFile As String
Dim WbkSrc As Workbook, WshSrc As Worksheet
Dim WbkCsv As Workbook, WshCsv As Worksheet
Dim rData As Range

    sPathInp = "C:\temp\pydev\"
    sPathOut = "C:\temp\"
    sPathFile = Dir(sPathInp)

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Do While (sPathFile <> "")
        If Right(sPathFile, 4) = ".xls" Or Right(sPathFile, 5) = ".xlsx" Then

            Rem Initialize Objects
            Set WbkSrc = Nothing
            Set WshSrc = Nothing

            Rem Set Objects
            On Error Resume Next
            Set WbkSrc = Workbooks.Open(sPathInp & sPathFile)
            If Not (WbkSrc Is Nothing) Then
                Set WshSrc = WbkSrc.Sheets(kWshName)

                If Not (WshSrc Is Nothing) Then
                    On Error GoTo 0

                    Rem Set Csv Filename
                    sCsvFile = Left(sPathFile, -1 + InStrRev(sPathFile, "."))
                    sCsvFile = sCsvFile & " - " & kWshName

                    Rem Calculate, Unhide Rows & Columns & Copy Data Sheet
                    With WshSrc
                        .Calculate
                        .Cells.EntireRow.Hidden = False
                        .Cells.EntireColumn.Hidden = False
                        .Copy
                    End With
                    Set WshCsv = ActiveSheet

                    Rem Delete All Other Columns
                    With Range(WshCsv.Cells(1), WshCsv.UsedRange.SpecialCells(xlLastCell))
                        .Value = .Value
                        Set rData = Union(Columns("A"), Columns("P"), Columns("AC"))
                        rData.EntireColumn.Hidden = True
                        .SpecialCells(xlCellTypeVisible).EntireColumn.Delete
                        rData.EntireColumn.Hidden = False
                    End With

                    Rem Save as Csv
                    WshCsv.SaveAs Filename:=sPathOut & sCsvFile, FileFormat:=xlCSV
                    WshCsv.Parent.Close
                    WbkSrc.Close

        End If: End If: End If

        sPathFile = Dir
        On Error GoTo 0

    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    End Sub

每个工作簿中的一个工作表需要保存为CSV

1 个答案: