Excel 2010 - экспорт одного XSLM в несколько файлов CSV

Question

Хорошо, поэтому, в основном у меня есть файл XSLM, содержащий около ~ 40 тыс. Строк. Мне нужно экспортировать эти строки в настраиваемый формат CSV -^и ограничить границы каждой ячейки. После их экспорта они считываются приложением импортера Joomla и обрабатываются в базе данных. Я нашел хороший макро-скрипт, который делает именно это и настраивает его, чтобы использовать правильные разделители.

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. Задаёт пользователю, сколько строк должно выводиться на каждый файл.
3. Добавляет -pt # к выбранному сохранению в качестве имени файла.
4. Обрабатывает файл Excel как можно больше «chunk» csv-файлов.

Например, если мое имя файла было выведено, номер прерывания файла был 5000, а файл excel имел 14000 строк, я бы закончил вывод-pt1.csv, output-pt2.csv и выход-pt3.csv.

Если бы я только это делал, я бы просто разрывал файлы вручную, но когда все было сказано и сделано, мне нужно передать эти файлы клиенту, введя в эксплуатацию проект, так что чем проще, тем лучше.

Очень ценим любые идеи.

Answer 1

Что-то вроде этого может сработать для вас. Непроверенная, но компилирует ...

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

Таким образом, с помощью Тима, вот окончательный вариант, который принимает аргумент на максимальное число строк в файле, и выводит как много суб-файлов по мере необходимости.

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 

Я просто добавил запрос для ввода данных пользователя, чтобы получить максимум строки, а также подправил его, чтобы он не обновит строку заголовка с каждым новым файлом. Спасибо еще раз за помощь.