|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Разбивка строк общего файла на отдельные csv файлы |
|
VBA - Разбивка строк общего файла на отдельные csv файлы
|
Пользователь Сообщения: 60 |
Профиль | Отправить PM | Цитировать
Добрый день всем!! Нужна помощь с написанием макроса.
Имеется 3 папки Шаблон, Реестр и Итог В папке Реестр лежит исходный файл excel с данными. В папке шаблон лежит файл с именем check формата csv, который планируется использовать в качестве шаблона. Нужен макрос, который бы открывал исходный файл, копировал данные в файл шаблона.csv и сохранял этот файл шаблона в папку "Итог" с именем сheck1. Каждая строка исходного файла = один файл check. То есть если в исходном файле условно 50 строк, то должно получиться 49 чеков(в последнюю строку исходного файла выводится общая сумма, она не нужна) Имена файлов в папке итог должны быть от check1 до условно check49 Данные для копирования: E2(исх) в B3(шаблон); E2(исх) в F2(шаблон); F2(исх) в D3,D4,H3(шаблон) В файле шаблона check ячейка L3 должна рассчитываться по формуле (F2(исх)*18)/118 F2, E2 это ячейки первой строки с данными, т.к выше только заголовки столбцов. То есть когда цикл пробегает по следующей строчке, будет уже не F2, E2 а F3, E3 и т.д Надеюсь понятно объяснил) С VBA знаком крайне поверхностно. Нашел на форуме лишь решение по копированию файлов. Sub DirCopy() Dim OldPath$, NewPath$, Shablon$, OnlyName$ OldPath = "C:\proba\zvit\" NewPath = "C:\proba\Temp\" Shablon = "*.*" OnlyName = Dir(OldPath & Shablon, vbReadOnly + vbHidden + vbSystem) Do Until OnlyName = "" FileCopy OldPath & OnlyName, NewPath & OnlyName OnlyName = Dir Loop End Sub |
|
Отправлено: 14:08, 02-09-2018 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата jordan_74:
Цитата jordan_74:
|
||
Отправлено: 16:24, 04-09-2018 | #11 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать jordan_74, примерно так (на WSH):
Скрытый текст
Option Explicit Const xlCSV = 6 Const xlWindows = 2 Dim strTemplateFile Dim strSourceFile Dim strDestFolder Dim objFSO Dim objExcel Dim objTemplateFile Dim objSourceFile Dim i Dim strDestFile Dim anyValue strTemplateFile = "C:\Мои проекты\0191\Архив\Архив\Шаблон\check.csv" strDestFolder = "C:\Мои проекты\0191\Архив\Архив\Итог" If WScript.Arguments.Count = 1 Then strSourceFile = WScript.Arguments.Item(0) Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strTemplateFile) Then If objFSO.FileExists(strSourceFile) Then If objFSO.FolderExists(strDestFolder) Then Set objExcel = WScript.CreateObject("Excel.Application") objExcel.Workbooks.OpenText strTemplateFile, , , , , , , , , , , , , , , , , True Set objTemplateFile = objExcel.Workbooks.Item(1) Set objSourceFile = objExcel.Workbooks.Open(strSourceFile, False, True) For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2 With objTemplateFile.Worksheets.Item(1) anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 5).Value .Range("B3").Value = anyValue .Range("F2").Value = anyValue anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 6).Value .Range("D3").Value = anyValue .Range("D4").Value = anyValue .Range("H3").Value = anyValue .Range("L3").Value = Round((anyValue * 18) / 118, 1) End With strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & "_" & objFSO.GetBaseName(strSourceFile) & "_" & Right("000" & CStr(i), 3) & "." & objFSO.GetExtensionName(strTemplateFile)) If objFSO.FileExists(strDestFile) Then objFSO.DeleteFile strDestFile, True End If objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True Next objSourceFile.Close False objTemplateFile.Close False objExcel.Quit Set objExcel = Nothing Else WScript.Echo "Can't find destination folder [" & strDestFolder & "]." WScript.Quit 4 End If Else WScript.Echo "Can't find source file [" & strSourceFile & "]." WScript.Quit 3 End If Else WScript.Echo "Can't find template file [" & strTemplateFile & "]." WScript.Quit 2 End If Set objFSO = Nothing Else WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file>" WScript.Quit 1 End If WScript.Quit 0 пробуйте. Путь к файлу шаблона и целевой папке задаётся жёстко в скрипте, путь к исходному файлу указывается аргументом скрипта (также можно просто перетянуть исходный файл на скрипт в Проводнике). |
Последний раз редактировалось Iska, 04-09-2018 в 19:17. Причина: Добавил указанное округление Отправлено: 18:29, 04-09-2018 | #12 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Цитата Iska:
|
|
Отправлено: 18:50, 04-09-2018 | #13 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата jordan_74:
P.S. Забыл самое главное — одноимённые файлы, уже существующие в целевом каталоге, будут молча перезаписаны (точнее — удалены, а на их место будут записаны новые файлы). |
|
Отправлено: 19:17, 04-09-2018 | #14 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Iska,
Скопировал код, сохранил в формате .js но при запуске возникла ошибка, может я что то криво сделал Скрытый текст
Option Explicit
Const xlCSV = 6 Const xlWindows = 2 Dim strTemplateFile Dim strSourceFile Dim strDestFolder Dim objFSO Dim objExcel Dim objTemplateFile Dim objSourceFile Dim i Dim strDestFile Dim anyValue strTemplateFile = "C:\РЕЕСТР ЧЕКОВ\Шаблон\check.csv" strDestFolder = "C:\РЕЕСТР ЧЕКОВ\Итог" If WScript.Arguments.Count = 1 Then strSourceFile = WScript.Arguments.Item(0) Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strTemplateFile) Then If objFSO.FileExists(strSourceFile) Then If objFSO.FolderExists(strDestFolder) Then Set objExcel = WScript.CreateObject("Excel.Application") objExcel.Workbooks.OpenText strTemplateFile, , , , , , , , , , , , , , , , , True Set objTemplateFile = objExcel.Workbooks.Item(1) Set objSourceFile = objExcel.Workbooks.Open(strSourceFile, False, True) For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2 With objTemplateFile.Worksheets.Item(1) anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 5).Value .Range("B3").Value = anyValue .Range("F2").Value = anyValue anyValue = objSourceFile.Worksheets.Item(1).Cells.Item(i + 1, 6).Value .Range("D3").Value = anyValue .Range("D4").Value = anyValue .Range("H3").Value = anyValue .Range("L3").Value = Round((anyValue * 18) / 118, 1) End With strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & "_" & objFSO.GetBaseName(strSourceFile) & "_" & Right("000" & CStr(i), 3) & "." & objFSO.GetExtensionName(strTemplateFile)) If objFSO.FileExists(strDestFile) Then objFSO.DeleteFile strDestFile, True End If objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True Next objSourceFile.Close False objTemplateFile.Close False objExcel.Quit Set objExcel = Nothing Else WScript.Echo "Can't find destination folder [" & strDestFolder & "]." WScript.Quit 4 End If Else WScript.Echo "Can't find source file [" & strSourceFile & "]." WScript.Quit 3 End If Else WScript.Echo "Can't find template file [" & strTemplateFile & "]." WScript.Quit 2 End If Set objFSO = Nothing Else WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file>" WScript.Quit 1 End If WScript.Quit 0 |
Последний раз редактировалось jordan_74, 04-09-2018 в 20:32. Отправлено: 19:57, 04-09-2018 | #15 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата jordan_74:
|
|
Отправлено: 20:37, 04-09-2018 | #16 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Iska,
Сохранил в формате .vbs Отработало как надо. Вопрос, нужно именно перетаскивать файл реестра на скрипт, или все таки можно сделать обычным двойным кликом? |
Последний раз редактировалось jordan_74, 04-09-2018 в 21:16. Отправлено: 20:43, 04-09-2018 | #17 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать |
Отправлено: 21:27, 04-09-2018 | #18 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Цитата Iska:
Тем не менее огромное спасибо Iska, вы очень помогли и облегчили работу многим людям. У меня финальная просьба, т.к я с wsh вообще не знаком, могли бы прокомментировать блоки кода, чтобы понять что делается на разных этапах..!? |
|
Отправлено: 06:51, 05-09-2018 | #19 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата jordan_74:
|
|
Отправлено: 07:11, 05-09-2018 | #20 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
CMD/BAT - Создание .bat файла для выборки строк из .csv файла в .xlsx | GODolubOFF | Скриптовые языки администрирования Windows | 10 | 14-12-2015 15:34 | |
CMD/BAT - Чтение указанной строки и разбив на отдельные символы и запись их в отдельные меремен | angel_lyucifer | Скриптовые языки администрирования Windows | 0 | 10-05-2015 20:48 | |
CMD/BAT - [решено] Периеминование файла doc.csv в Документ_дата_время.csv | kagorec | Скриптовые языки администрирования Windows | 2 | 29-03-2014 18:40 | |
CMD/BAT - [решено] Разбивка текстового файла файла | Seryoga204 | Скриптовые языки администрирования Windows | 1 | 04-10-2010 21:19 | |
Установка - Разбивка файла .gho на куски | Pavelnt | Microsoft Windows 2000/XP | 2 | 15-05-2009 12:15 |
|