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

На чтение 4 мин Опубликовано 28.09.2024

Содержание

Вопрос или проблема
Ответ или решение
Пояснения к изменениям:

Вопрос или проблема

У меня есть макрос, который я использую для разбивки больших файлов Excel на более мелкие. Он работает идеально, за исключением того, что он использует строку заголовка только в первом созданном файле, и эта строка заголовка (строка 1) должна быть вверху каждого нового файла. Есть ли способ модифицировать этот код, чтобы каким-то образом вставить эту строку в все файлы?

Sub SplitSheets()

' Сохранить лист в строках по 25000 в последовательные CSV файлы
' JBeaucaire (27/07/2009)

Dim LR As Long, i As Long, Cntr As Long

Dim ws As Worksheet, OldDir As String

If MsgBox("Это ли лист, с которого нужно разобрать данные?", vbYesNo + vbQuestion) = vbNo Then Exit Sub LR = Range("A" & Rows.Count).End(xlUp).row

Set ws = ActiveSheet

OldDir = CurDir     'запоминает текущий рабочий путь пользователя

Dim v: v = Evaluate("ISREF(TEMP!A1)")

    If Not v Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
    Else
        Sheets("Temp").Activate
        Cells.Clear
    End If

ChDir "C:\Users\BartB\Desktop\sheets"     'путь для сохранения CSV файла

    For i = 1 To LR Step 2000
        ws.Rows(i & ":" & i + 1999).Copy Range("A1")
        Cntr = Cntr + 1
        ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        Cells.Clear
    Next i

ChDir OldDir        'восстанавливает оригинальный рабочий путь пользователя
End Sub

Вам нужно будет создать шаг в коде. Прямо перед циклом For Next напишите код, который жестко закрепляет строку один в новом файле. После этого просто убедитесь, что вы начинаете запись со второй строки. Это достигается изменением строки “For i = 2 to LR Step 2000”

    ws.Rows("1:1").Copy Range("A1")
    Cntr = Cntr + 1
    ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Cells.Clear

For i = 1 To LR Step 2000
    ws.Rows(i & ":" & i + 1999).Copy Range("A1")
    Cntr = Cntr + 1
    ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    Cells.Clear
Next i

Попробуйте с этим поиграться, но это и есть идея.

Ответ или решение

Конечно! Вы можете модифицировать ваш макрос, чтобы вставить строку заголовка в каждый новый файл. Ниже приведен обновленный код, который сделает это:

Sub SplitSheets()

' Разделить большой лист на меньшие файлы, сохраняя заголовок в каждом файле
' Автор: JBeaucaire, изменено для сохранения заголовка

Dim LR As Long, i As Long, Cntr As Long
Dim ws As Worksheet, OldDir As String

' Проверка, является ли текущий лист тем, который нужно обрабатывать
If MsgBox("Это лист, из которого нужно извлечь данные?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
LR = Range("A" & Rows.Count).End(xlUp).Row

Set ws = ActiveSheet
OldDir = CurDir ' Запоминаем текущий рабочий путь

' Настраиваем рабочую директорию для сохранения файлов
ChDir "C:\Users\BartB\Desktop\sheets" ' Указать путь для сохранения файлов CSV

' Копируем заголовок в каждый файл
ws.Rows("1:1").Copy

For i = 2 To LR Step 2000 ' Начинаем с 2, чтобы пропустить заголовок
    ' Создаем новый файл
    Cells.Clear ' Очищаем содержимое временного листа
    Range("A1").PasteSpecial xlPasteAll ' Вставляем заголовок в первую строку

    ' Копируем данные в файл
    ws.Rows(i & ":" & Application.Min(i + 1999, LR)).Copy Range("A2") ' Вставляем данные, начиная со второй строки

    Cntr = Cntr + 1
    ActiveWorkbook.SaveAs Filename:="File" & Cntr & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Next i

ChDir OldDir ' Возвращаемся к исходному рабочему пути
End Sub

Пояснения к изменениям:

Копирование заголовка: Мы копируем строку заголовка (первая строка) перед началом цикла, так что она будет присутствовать в каждом новом файле.
Изменение начального переменного цикла: Используйте For i = 2 To LR Step 2000, чтобы начать копирование данных с самой второй строки, пропуская заголовок.
Копирование данных: Вставка данных происходит в диапазон, начиная со второй строки (Range("A2")), чтобы оставить первую строку для заголовка.

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