Нарезка эксель-файла в текстовые файлы

@Юля-красотуля · Регистрация: 22.04.2013

Студворк — интернет-сервис помощи студентам

Добрый день, уважаемые форумчане.

Подскажите пожалуйста возможно ли сделать такое с помощью VBA в excel: А то уже пол дня сегодня копирую строчки.

Итак есть файл excel, структура - 4 столбца и 1 000 000 строк и такая же структкра в другом файле excel, только с другими данными.
Мне нужно нарезать файлы excel в txt файлы следующим образом:
первый файл txt, например, D1.txt это 20 000 записей из первого файла excel
второй файл txt, например D2.txt объемом 100 000 записей ( то есть 25 000 строк и 4 столбца данных),
где 20 000 записей из первого файла excel (теже самые что уже есть в D1.txt), а 80 000 записей из второго файла excel

следующий файл D1.txt будет j, объемом 40 000 записей из первого файла excel
к нему сопряженный D2.txt - 200 000 записей, из который 40 000 это теже 40 000 записей из файлв D1.txt, а остальные 160 000 записей из второго файла excel

вот таким оразом, необходимо нарезать txt файлы из двух файлов excel, размеры текстовых файлов от 100 000 до 1 000 000 записей

где во всех случаях получаются объемы файлов D1.txt/D2.txt = 1/5

Подскажите, пожалуйста, возможно ли это сделать средствами VBA или нет. И, если не тяжело, то показать как написать такой скриптик, а то я уже пол дня промучалась копировать эти строчки по файлам

@barbudo59 · 25.04.2013, 19:17

Что называется, "решение в лоб"

Формирование D1.txt

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Ìàêðîñ1()
'
' Ìàêðîñ1 Ìàêðîñ
' Ìàêðîñ çàïèñàí 25.04.2013 (ret)
'
 
'
    Rows("21000:62501").Select    'Удаление "лишних" строк
    Selection.ClearContents
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\XXXXXXXXXX\Ìîè äîêóìåíòû\D1.txt", FileFormat:=xlText _
        , CreateBackup:=False
End Sub

Формирование D2.txt

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Ìàêðîñ2()
'
' Ìàêðîñ2 Ìàêðîñ
' Ìàêðîñ çàïèñàí 25.04.2013 (ret)
'
 
'
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\XXXXXXXXX\Ìîè äîêóìåíòû\D1.txt", Origin:=866, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
        Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
        Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
        16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
        Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1)), _
        TrailingMinusNumbers:=True
    Windows("2.xls").Activate
    Rows("1:62501").Select
    Selection.Copy
    Windows("D1.txt").Activate
    Rows("20001:20001").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
'Здесь надо будет добавить со следующего листа 17499 строк
    Windows("2.xls").Activate
    Sheets("Лист2").Select
    Rows("1:17499").Select
    Selection.Copy
'
    Windows("D1.txt").Activate
    Rows("82502:82502").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\XXXXXXXX\Ìîè äîêóìåíòû\D2.txt", FileFormat:=xlText _
        , CreateBackup:=False
End Sub

@Юля-красотуля · 25.04.2013, 20:44 **[ТС]**

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

@Surrogate · 25.04.2013, 22:31

Дык там в "левой кодировке" только комменты и путь файла. Путь у тебя все равно будет свой.

с помощью проги TCode, расшифровал крокозябры

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub Макрос1()
 ' Макрос1 Макрос
 ' Макрос записан 25.04.2013 (ret)
 '
 '
 Rows("21000:62501").Select 'Удаление "лишних" строк
 Selection.ClearContents
 ActiveWorkbook.SaveAs Filename:= _
 "C:\Documents and Settings\XXXXXXXXXX\Мои документы\D1.txt", FileFormat:=xlText _
 , CreateBackup:=False
 End Sub
' =====
Sub Макрос2()
 '
 ' Макрос2 Макрос
 ' Макрос записан 25.04.2013 (ret)
 '
 '
 Workbooks.OpenText Filename:= _
 "C:\Documents and Settings\XXXXXXXXX\Мои документы\D1.txt", Origin:=866, _
 StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:ъlse, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1)), _
TrailingMinusNumbers:=True
Windows("2.xls").Activate
Rows("1:62501").Select
Selection.Copy
Windows("D1.txt").Activate
Rows("20001:20001").Select
ActiveSheet.Paste
Application.CutCopyMode = False
 
'Здесь надо будет добавить со следующего листа 17499 строк
Windows("2.xls").Activate
Sheets("Лист2").Select
Rows("1:17499").Select
Selection.Copy
'
Windows("D1.txt").Activate
Rows("82502:82502").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\XXXXXXXX\Мои документы\D2.txt", FileFormat:=xlText _
, CreateBackup:=False
End Sub

@Апострофф · 26.04.2013, 07:31

Не по теме:

Сообщение от Юля-красотуля

с кодировкой не все хорошо

barbudo59, копируйте код при включенной русской раскладке клавиатуры,
и плюсом пользуйтесь тегами языка программирования (это гораздо эффективнее использования спойлеров)
Тогда не понадобятся танцы с бубнами (прогой TCode тобишь)

@Юля-красотуля · 26.04.2013, 16:19 **[ТС]**

скажите пожалуйста, после запуска макроса 1(), он потер весь первый лис (Лист1), его больше не существует, с этим можно как-то бороться или лучше преред каждым разом создавать резервную копию ?

@barbudo59 · 26.04.2013, 16:26

Я просто закрывал *.xls без сохранения.

@Юля-красотуля · 26.04.2013, 16:49 **[ТС]**

Хорошо, Спасибо :О)
Вы меня очень выручили!
Со вторым макросом еще не очень разобралась, но если что, я обязательно напишу

@barbudo59 · 26.04.2013, 17:15

Открою ВЕЛИКУЮ ТАЙНУ - я макросы не писал,

а записывал (Сервис-Макросы-Запись), а потом только цифры корректировал. Попробуте так же - возможно будет проще.

@Юля-красотуля · 26.04.2013, 19:35 **[ТС]**

подскажите пожалуйста, что тут не так
это попытка испортить данные, путем добавления к четырем строчкам из пяти 5000

Visual Basic
1
2
3
4
5
6
7
Sub Macros()
For Each cell In Selection
    If cell.Row Mod 5 <> 0 Then 
        cell.Formula = "=" & cell.Value & "+5000"
    End If
Next
End Sub

после запуска макрос отрабатывает, минут 40 и так и не завершает свою работу, а там все 25 000 строк

@KoGG · 29.04.2013, 16:16

Если в выделенных ячейках числа, а не текст, то:
...

Visual Basic
1
cell.Value = cell.Value + 5000

@Surrogate · 30.04.2013, 13:34

Сообщение от Юля-красотуля

подскажите пожалуйста, что тут не так
это попытка испортить данные, путем добавления к четырем строчкам из пяти 5000
…
после запуска макрос отрабатывает, минут 40 и так и не завершает свою работу, а там все 25 000 строк

странно у меня все работает

а что надо было сделать: просто прибавить 5000 или заменить формулы в ячейках ?

@Юля-красотуля · 01.05.2013, 17:56 **[ТС]**

Спасибо всем огромное! Все получилось, все работает!

Новые блоги и статьи Все статьи Все блоги /
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .	Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .	Оттачиваю умение писать js программы. russiannick 30.08.2026 Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .

@Юля-красотуля 2 / 2 / 0 Регистрация: 22.04.2013 Сообщений: 13

	Нарезка эксель-файла в текстовые файлы 22.04.2013, 22:28. Показов 5989. Ответов 31 Метки нет (Все метки) Добрый день, уважаемые форумчане. Подскажите пожалуйста возможно ли сделать такое с помощью VBA в excel: А то уже пол дня сегодня копирую строчки. Итак есть файл excel, структура - 4 столбца и 1 000 000 строк и такая же структкра в другом файле excel, только с другими данными. Мне нужно нарезать файлы excel в txt файлы следующим образом: первый файл txt, например, D1.txt это 20 000 записей из первого файла excel второй файл txt, например D2.txt объемом 100 000 записей ( то есть 25 000 строк и 4 столбца данных), где 20 000 записей из первого файла excel (теже самые что уже есть в D1.txt), а 80 000 записей из второго файла excel следующий файл D1.txt будет j, объемом 40 000 записей из первого файла excel к нему сопряженный D2.txt - 200 000 записей, из который 40 000 это теже 40 000 записей из файлв D1.txt, а остальные 160 000 записей из второго файла excel вот таким оразом, необходимо нарезать txt файлы из двух файлов excel, размеры текстовых файлов от 100 000 до 1 000 000 записей где во всех случаях получаются объемы файлов D1.txt/D2.txt = 1/5 Подскажите, пожалуйста, возможно ли это сделать средствами VBA или нет. И, если не тяжело, то показать как написать такой скриптик, а то я уже пол дня промучалась копировать эти строчки по файлам 0

@Юля-красотуля 2 / 2 / 0 Регистрация: 22.04.2013 Сообщений: 13
	25.04.2013, 20:44 [ТС]
	вероятно код очень простой и изящный, но с кодировкой не все хорошо, можно попросить вас записать или в файл или в другой кодировке 1

@Юля-красотуля 2 / 2 / 0 Регистрация: 22.04.2013 Сообщений: 13
	26.04.2013, 16:19 [ТС]
	скажите пожалуйста, после запуска макроса 1(), он потер весь первый лис (Лист1), его больше не существует, с этим можно как-то бороться или лучше преред каждым разом создавать резервную копию ? 0

@barbudo59 Я не экстрасенс 382 / 339 / 34 Регистрация: 22.01.2013 Сообщений: 1,126
	26.04.2013, 16:26
	Я просто закрывал *.xls без сохранения. 0

@Юля-красотуля 2 / 2 / 0 Регистрация: 22.04.2013 Сообщений: 13
	26.04.2013, 16:49 [ТС]
	Хорошо, Спасибо :О) Вы меня очень выручили! Со вторым макросом еще не очень разобралась, но если что, я обязательно напишу 0

@barbudo59 Я не экстрасенс 382 / 339 / 34 Регистрация: 22.01.2013 Сообщений: 1,126
	26.04.2013, 17:15
	Открою ВЕЛИКУЮ ТАЙНУ - я макросы не писал, а записывал (Сервис-Макросы-Запись), а потом только цифры корректировал. Попробуте так же - возможно будет проще. 0

@Юля-красотуля 2 / 2 / 0 Регистрация: 22.04.2013 Сообщений: 13
	01.05.2013, 17:56 [ТС]
	Спасибо всем огромное! Все получилось, все работает! 0