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

Question

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

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 строк, я бы в итоге получил output-pt1.csv, output-pt2.csv и output-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

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