将数据从现有工作表复制到新的 csv 文件

Question

我正在尝试创建一个 Excel 工具来将一张数据拆分为多个 .csv 文件，每个 csv 文件最多 200 行。

我的代码：

Dim CSheet As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim currentFilePath As String
Dim filePath As String
Dim dataDate As String
Dim n As Integer
Dim r As Integer
Dim rowStartNumber As Integer
Dim rowEndNumber As Integer
Dim numOfFiles As Integer


'*****************************************************
'  Declare variables
'*****************************************************
On Error Resume Next
Application.DisplayAlerts = False
Set CSheet = Worksheets("Cleaned_Data")
Worksheets("Cleaned_Data").Activate

LastRow = CSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = CSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Debug.Print (Application.ActiveWorkbook.Path)
currentFilePath = Application.ActiveWorkbook.Path

numOfFiles = (LastRow - 1) / 200

dataDate = Format(Worksheets("Instructions").Cells(14, 2), "DD-MMM-YYYY")
filePath = currentFilePath & "\" & dataDate

'*****************************************************
'  Check if folder exists; if yes delete and recreate
'*****************************************************

'if folder does not exist
If Dir(filePath, vbDirectory) = "" Then
    MkDir filePath
Else
    Kill filePath & "*.*"
    RmDir filePath
    MkDir filePath
End If


Debug.Print ("Hello")

' Loop to create the files
For n = 1 To numOfFiles
    rowStartNumber = 2 + ((n - 1) * 200)
    rowEndNumber = rowStartNumber + 199
    Debug.Print (rowStartNumber & " - " & rowEndNumber)
    For r = rowStartNumber To rowEndNumber
        Debug.Print (rowStartNumber)
        'Start to get data from Csheet, up to 200 rows, and write them into a new .csv file in filePath
    Next r
Next n

循环部分是我正在努力解决的问题。我尝试了许多复制粘贴的方法，或者逐行迭代并写出 .csv 文件。如何使用 VBA 做到这一点？

' Loop to create the files
For n = 1 To numOfFiles
    rowStartNumber = 2 + ((n - 1) * 200) 'first data row starts at row 2, due to headers
    rowEndNumber = rowStartNumber + 199
    Debug.Print (rowStartNumber & " - " & rowEndNumber)
    For r = rowStartNumber To rowEndNumber
        Debug.Print (rowStartNumber)
        'Start to get data from Csheet, up to 200 rows, and write them into a new .csv file in filePath
    Next r
Next n

Answer 1

你可以尝试这些方法，我已经设置了一个恒定的文件数，你可以使用你原来的分割代码来解决这个问题：

Private Const cstChunkSize As Long = 200

Sub implementation()

Dim lngFileNum As Long
Dim wbExport As Excel.Workbook
Dim wsExport As Excel.Worksheet
Dim lngCols As Long
Dim rngChunk As Excel.Range

lngCols = 20

For lngFileNum = 1 To 10

    Set wbExport = Workbooks.Add
    Set wsExport = wbExport.Worksheets(1)

    Set rngChunk = GetChunk(ThisWorkbook.Worksheets("Sheet1").Range("a1"), _
                    lngCols, lngFileNum)

    wsExport.Range("a1").Resize(cstChunkSize, lngCols).Value = rngChunk.Value

    wsExport.SaveAs "C:\Databases\CSV\NEWEST2_EXPORT_" & lngFileNum & ".csv", xlCSV

    wbExport.Close False

Next lngFileNum

Set wbExport = Nothing
Set wsExport = Nothing
Set rngChunk = Nothing

End Sub
Function GetChunk(rngStartPoint As Excel.Range, _
                    lngColumns As Long, _
                    lngChunkNumber As Long, _
                    Optional lngChunkSize As Long = cstChunkSize) As Excel.Range

Dim r As Excel.Range

Set r = rngStartPoint.Offset((lngChunkSize * (lngChunkNumber - 1)))
Set r = r.Resize(lngChunkSize, lngColumns)

Set GetChunk = r

End Function

Answer 2

按照 cmets 的建议，下面的代码会将数据聚合到一个新工作表中，然后将其保存为与原始工作簿相同的目录中的 CSV，我还在文件名中添加了一个数字以区分拆分文件：

Sub SplitToCSV()
Dim CSheet As Worksheet: Set CSheet = Worksheets("Cleaned_Data")
Dim ws As Worksheet
Dim LastRow As Long, LastCol As Long, numOfFiles As Integer
Dim filePath As String, dataDate As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False


    LastRow = CSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = CSheet.Cells(1, Columns.Count).End(xlToLeft).Column

    dataDate = Format(Worksheets("Instructions").Cells(14, 2), "DD-MMM-YYYY")
    WName = Left(Application.ActiveWorkbook.Name, InStr(Application.ActiveWorkbook.Name, ".") - 1)

    numOfFiles = (LastRow - 1) / 200

    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Temp"
    'create a Temp Worksheet

    For i = 1 To numOfFiles

        filePath = Application.ActiveWorkbook.Path & "\" & WName & " " & dataDate & " - " & i
        'Append the filenumber to the end of the filename

        ws.Rows(1).Value = CSheet.Rows(1).Value
        'copy headers

        If i = 1 Then
            CSheet.Range(CSheet.Cells(1 + (200 * (i - 1)), 1), CSheet.Cells(i * 200, LastCol)).Copy ws.Range("A1")
        Else
            CSheet.Range(CSheet.Cells(1 + (200 * (i - 1)), 1), CSheet.Cells(i * 200, LastCol)).Copy ws.Range("A2")
        End If
        'transfer data to Temp worksheet

        ws.Copy
        ActiveWorkbook.SaveAs Filename:=filePath, FileFormat:=xlCSV, CreateBackup:=True
        ActiveWorkbook.Close
        'Save worksheet as CSV

    Next i

    ws.Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub