{ "version": "https:\/\/jsonfeed.org\/version\/1.1", "title": "Заметки — Игорь К.: заметки с тегом макрос", "_rss_description": "Блог Игоря К. о маркетинге, аналитике, фотографии и жизни...", "_rss_language": "ru", "_itunes_email": "", "_itunes_categories_xml": "", "_itunes_image": "", "_itunes_explicit": "", "home_page_url": "https:\/\/blog.fossko.ru\/tags\/makros\/", "feed_url": "https:\/\/blog.fossko.ru\/tags\/makros\/json\/", "icon": "https:\/\/blog.fossko.ru\/pictures\/userpic\/userpic@2x.jpg?1610628098", "authors": [ { "name": "Игорь К.", "url": "https:\/\/blog.fossko.ru\/", "avatar": "https:\/\/blog.fossko.ru\/pictures\/userpic\/userpic@2x.jpg?1610628098" } ], "items": [ { "id": "541", "url": "https:\/\/blog.fossko.ru\/all\/makros-avtomaticheskogo-sohraneniya-csv-iz-ekselya\/", "title": "Макрос автоматического сохранения csv из экселя", "content_html": "

Есть файл состоящий из одного листа ID, нужно автоматически разделить количество строк по 10 и сохранить каждый диапазон в csv файл<\/p>\n

\n\"\"\n
Cтолбец с ID, которые нужно сохранить в отдельные файлы<\/div>\n<\/div>\n
\n\"\"\n
Делаем через макросы Разработчик — Visual basic.<\/div>\n<\/div>\n
\n\"\"\n
Если вкладки «Разработчик» нет, ее нужно включить через настройки: Параметры — Настроить ленту — Разработчик.<\/div>\n<\/div>\n
Sub SplitAndSave()\n    Dim SourceSheet As Worksheet\n    Dim NewSheet As Worksheet\n    Dim LastRow As Long\n    Dim Group As Long\n    Dim CurrentRow As Long\n    Dim Path As String\n    Dim DateTimeStr As String\n\n    ' Укажите имя вашего исходного листа\n    Set SourceSheet = ThisWorkbook.Sheets("Лист1")\n\n    ' Укажите путь для сохранения файлов\n    Path = "E:\\work\\csv\\"\n\n    ' Определите последнюю строку в столбце A\n    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row\n\n    ' Инциализируем переменные\n    CurrentRow = 2 ' Начинаем с 2, так как, вероятно, у вас есть заголовок\n    Group = 1\n\n    Do While CurrentRow <= LastRow\n        ' Создаем новый лист для текущей группы\n        Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))\n        NewSheet.Name = "Group" & Group\n\n      ' Копируем данные текущей группы на новый лист\n        SourceSheet.Rows(CurrentRow & ":" & IIf(CurrentRow + 9 <= LastRow, CurrentRow + 9, LastRow)).Copy Destination:=NewSheet.Rows(1)\n        \n        ' Создаем переменную с текущей датой в формате год-месяц-день-часы-минуты\n        DateTimeStr = Format(Now, "yyyy-mm-dd-hh-nn")\n        \n    ' Сохраняем новый лист в виде CSV файла с меткой времени\n        NewSheet.SaveAs Path & DateTimeStr & "_" & "Group" & Group & ".csv", xlCSV\n\n     ' Удаляем новый лист, если необходимо\n        Application.DisplayAlerts = False\n        NewSheet.Delete\n        Application.DisplayAlerts = True\n\n        ' Переходим к следующей группе\n        CurrentRow = CurrentRow + 10\n        Group = Group + 1\n    Loop\nEnd Sub<\/code><\/pre>
\n\"\"\n
В папку csv загрузились разделенные файлы<\/div>\n<\/div>\n
Добавим разбиение с сохранением заголовка из ячейки A1.
\nРазбивать будем по RowsPerGroup равном 1400 значений<\/p>\n
Sub SplitAndSaveWithHeaderVariable()\n    Dim SourceSheet As Worksheet\n    Dim NewSheet As Worksheet\n    Dim LastRow As Long\n    Dim Group As Long\n    Dim CurrentRow As Long\n    Dim Path As String\n    Dim DateTimeStr As String\n    Dim HeaderVariable As String\n    Dim RowsPerGroup As Long\n\n    ' Укажите имя вашего исходного листа\n    Set SourceSheet = ThisWorkbook.Sheets("Лист1")\n\n    ' Укажите путь для сохранения файлов\n    Path = "E:\\work\\csv\\"\n\n   ' Определите последнюю строку в столбце A\n    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row\n\n    ' Инициализируйте переменные\n    CurrentRow = 2 ' Начинаем с 2, предполагая, что у вас есть заголовок\n    Group = 1\n\n    ' Установите значение переменной заголовка из ячейки A1\n    HeaderVariable = SourceSheet.Cells(1, 1).Value\n\n    ' Установите количество строк в группе\n    RowsPerGroup = 1400\n\n    Do While CurrentRow <= LastRow\n       ' Создаем новый лист для текущей группы\n        Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))\n        NewSheet.Name = "Group" & Group\n\n       ' Вставляем переменную заголовка в первую ячейку нового листа\n        NewSheet.Cells(1, 1).Value = HeaderVariable\n\n        ' Копируем данные текущей группы на новый лист\n        SourceSheet.Rows(CurrentRow & ":" & IIf(CurrentRow + RowsPerGroup - 1 <= LastRow, CurrentRow + RowsPerGroup - 1, LastRow)).Copy Destination:=NewSheet.Rows(2)\n\n       ' Получаем текущую дату и время в указанном формате\n        DateTimeStr = Format(Now, "yyyy-mm-dd-hh-nn")\n\n       ' Сохраняем новый лист в виде файла CSV с датой и временем в имени файла\n        NewSheet.SaveAs Path & DateTimeStr & "_" & "Group" & Group & ".csv", xlCSV\n\n        ' Удаляем новый лист, если необходимо\n        Application.DisplayAlerts = False\n        NewSheet.Delete\n        Application.DisplayAlerts = True\n\n       ' Переходим к следующей группе\n        CurrentRow = CurrentRow + RowsPerGroup\n        Group = Group + 1\n    Loop\nEnd Sub<\/code><\/pre>",
            "date_published": "2023-12-06T21:26:06+03:00",
            "date_modified": "2023-12-06T21:25:56+03:00",
            "tags": [
                "макрос",
                "таблицы",
                "эксель"
            ],
            "image": "https:\/\/blog.fossko.ru\/pictures\/makros-avtomaticheskogo-sohraneniya-csv-iz-ekselya.png",
            "_date_published_rfc2822": "Wed, 06 Dec 2023 21:26:06 +0300",
            "_rss_guid_is_permalink": "false",
            "_rss_guid": "541",
            "_e2_data": {
                "is_favourite": false,
                "links_required": [
                    "highlight\/highlight.js",
                    "highlight\/highlight.css"
                ],
                "og_images": [
                    "https:\/\/blog.fossko.ru\/pictures\/makros-avtomaticheskogo-sohraneniya-csv-iz-ekselya.png",
                    "https:\/\/blog.fossko.ru\/pictures\/makros-avtomaticheskogo-sohraneniya-csv-iz-ekselya-1.png",
                    "https:\/\/blog.fossko.ru\/pictures\/Parametry-Excel-2023-12-05-23.47.32.jpg",
                    "https:\/\/blog.fossko.ru\/pictures\/csv-2023-12-05-23.41.26.jpg"
                ]
            }
        }
    ],
    "_e2_version": 4171,
    "_e2_ua_string": "Aegea 11.4 (v4171)"
}