Excel 2010 – 将单个XSLM导出到多个CSV文件

好吧，所以，基本上我有一个XSLM文件，包含大约40k行。 我需要将这些行导出到自定义的CSV格式 – ^分隔和〜标记每个单元格的边界。 一旦它们被导出，它们被Joomla导入器应用程序读入并被处理到数据库中。 我发现了一个很好的macros脚本，并且调整它来使用正确的分隔符。

Sub CSVFile() Dim SrcRg As Range Dim CurrRow As Range Dim CurrCell As Range Dim CurrTextStr As String Dim ListSep As String Dim FName As Variant FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") 'ListSep = Application.International(xlListSeparator) ListSep = "^" ' Use ^ as field separator. If Selection.Cells.Count > 1 Then Set SrcRg = Selection Else Set SrcRg = ActiveSheet.UsedRange End If Open FName For Output As #1 For Each CurrRow In SrcRg.Rows CurrTextStr = ìî For Each CurrCell In CurrRow.Cells CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep Next While Right(CurrTextStr, 1) = ListSep CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) Wend Print #1, CurrTextStr Next Close #1 End Sub 

但是，我发现生成的CSV文件太大，无法用可用的脚本执行时间来处理。 我可以手动将文件分割成大约5000行，它做得很好。 我想要做的就是调整上面的脚本，如下所示：

1. 存储要插入每个文件的标题行。
2. 询问用户每个文件应该输出多less行。
3. 附加-pt＃到所选的保存文件名。
4. 根据需要将Excel文件处理成尽可能多的“块”csv文件。

例如，如果输出了我的文件名，文件中断号是5000，excel文件有14000行，那么我会输出pt1.csv，output-pt2.csv和output-pt3.csv。

如果只是我这样做，我只是不断手动打破文件，但当所有的说法和做完，我需要把这些文件交给客户委托项目，所以越容易越好。

非常赞赏任何想法。

Answer 1

像这样的东西可能会为你工作。 未经testing，但编译…

 Sub CSVFile() Const MAX_ROWS As Long = 5000 Dim SrcRg As Range Dim CurrRow As Range Dim CurrCell As Range Dim CurrTextStr As String Dim ListSep As String Dim FName As Variant, newFName As String Dim TextHeader As String, lRow As Long, lFile As Long FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") 'ListSep = Application.International(xlListSeparator) ListSep = "^" ' Use ^ as field separator. If Selection.Cells.Count > 1 Then Set SrcRg = Selection Else Set SrcRg = ActiveSheet.UsedRange End If lRow = 0 lFile = 1 newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv") Open newFName For Output As #1 For Each CurrRow In SrcRg.Rows lRow = lRow + 1 CurrTextStr = "" For Each CurrCell In CurrRow.Cells CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep Next While Right(CurrTextStr, 1) = ListSep CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) Wend If lRow = 1 Then TextHeader = CurrTextStr Print #1, CurrTextStr If lRow > MAX_ROWS Then Close #1 lFile = lFile + 1 newFName = Replace(FName, ".csv", "_pt" & lFile & ".csv") Open newFName For Output As #1 Print #1, TextHeader lRow = 0 End If Next Close #1 End Sub 

Answer 2

所以，在Tim的帮助下，最终版本接受每个文件最大行数的参数，并根据需要输出到尽可能多的子文​​件。

 Sub CSVFile() Dim MaxRows As Long Dim SrcRg As Range Dim CurrRow As Range Dim CurrCell As Range Dim CurrTextStr As String Dim ListSep As String Dim FName As Variant, newFName As String Dim TextHeader As String, lRow As Long, lFile As Long FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") MaxRows = Application.InputBox(Prompt:="Enter maximum number of rows per file.", _ Default:=5000, Type:=1) 'ListSep = Application.International(xlListSeparator) ListSep = "^" ' Use ^ as field separator. If Selection.Cells.Count > 1 Then Set SrcRg = Selection Else Set SrcRg = ActiveSheet.UsedRange End If lRow = 0 lFile = 1 newFName = Replace(FName, ".csv", "-pt" & lFile & ".csv") Open newFName For Output As #1 For Each CurrRow In SrcRg.Rows lRow = lRow + 1 CurrTextStr = "" For Each CurrCell In CurrRow.Cells CurrTextStr = CurrTextStr & "~" & CurrCell.Value & "~" & ListSep Next While Right(CurrTextStr, 1) = ListSep CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) Wend If lRow = 1 And lFile = 1 Then TextHeader = CurrTextStr 'Capture the header row Print #1, CurrTextStr If lRow > MaxRows Then Close #1 lFile = lFile + 1 newFName = Replace(FName, ".csv", "-pt" & lFile & ".csv") Open newFName For Output As #1 Print #1, TextHeader lRow = 0 End If Next Close #1 End Sub 

我只是添加了一个用户input的请求来获取最大的行，并且调整了它，所以它没有更新每个新文件的标题行。 再次感谢您的帮助。