|
Компьютерный форум 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 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Приветствую уважаемые форумчане!!!!!
Очень нужна помощь!!! нужно реализовать возможность запуска программы с любого компьютера в сети. Тоесть без привязки к конкретным путям. Скрытый текст
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 |
Отправлено: 20:33, 30-10-2018 | #41 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать jordan_74, я могу лишь повторить свой вопрос — как Вы это видите?
|
Отправлено: 20:46, 30-10-2018 | #42 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Iska, Файл скрипта и шаблон чека находятся в отдельных папка в сети.
У пользователя папка с файлом реестра и папка с целевыми файлами чеков, а также исполнительный файл, который запускает процесс преобразования. Пользователь запускает условно батник, который запускает в работу скрипт, лежащий в сети. Скрипт обрабатывает файл реестра и складывает готовые файлы чека в итоговую папку. Как конкретно это реализовать откровенно говоря не знаю ( |
Отправлено: 21:09, 30-10-2018 | #43 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать |
Отправлено: 21:55, 30-10-2018 | #44 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Цитата Iska:
|
|
Отправлено: 22:07, 30-10-2018 | #45 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Цитата jordan_74:
Например, каталог с файлами реестра располагается в «C:\Мои проекты\0191\Архив\Архив\Реестр». Тогда скрипт будет предполагать наличие каталога для целевых файлов рядом с каталогом с файлами реестра, т.е, относительно каталога с файлами реестра — как «..\Итог», что в данном конкретном случае отобразится на каталог «C:\Мои проекты\0191\Архив\Архив\Итог». Или же: «C:\Моя папка\Мой Реестр» и, соответственно — «C:\Моя папка\Итог». Скрипт даже может сам создавать каталог для целевых файлов, буде таковое потребно. Цитата jordan_74:
|
||
Отправлено: 22:22, 30-10-2018 | #46 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Цитата Iska:
Я имел ввиду что каталог с целевыми файлами предполагает наличие рядом каталога с файлами реестра, именно так |
|
Отправлено: 22:27, 30-10-2018 | #47 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Попробуйте так:
Скрытый текст
Option Explicit
Const xlCSV = 6
Const xlWindows = 2
Dim strSourceFolder
Dim strTemplateFile
Dim strRelativeDestFolder
Dim strDestFolder
Dim objFSO
Dim objExcel
Dim objFile
Dim objTemplateFile
Dim objSourceFile
Dim i
Dim strDestFile
Dim anyValue
strTemplateFile = "\\Server01\Share01\Шаблон\check.csv"
strRelativeDestFolder = "..\Итог"
If WScript.Arguments.Count = 1 Then
strSourceFolder = WScript.Arguments.Item(0)
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strTemplateFile) Then
If objFSO.FolderExists(strSourceFolder) Then
strDestFolder = objFSO.GetAbsolutePathName(objFSO.BuildPath(strSourceFolder, strRelativeDestFolder))
If Not objFSO.FolderExists(strDestFolder) Then
objFSO.CreateFolder strDestFolder
End If
Set objExcel = Nothing
For Each objFile In objFSO.GetFolder(strSourceFolder).Files
Select Case LCase(objFSO.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
objExcel.Workbooks.OpenText strTemplateFile, , , , , , , , , , , , , , , , , True
Set objTemplateFile = objExcel.Workbooks.Item(1)
Set objSourceFile = objExcel.Workbooks.Open(objFile.Path, 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, 2)
End With
strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & "_" & objFSO.GetBaseName(objFile.Name) & "_" & 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
End Select
Next
If Not objExcel Is Nothing Then
objExcel.Quit
Set objExcel = Nothing
End If
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
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 folder>"
WScript.Quit 1
End If
WScript.Quit 0
Теперь пусть перетаскивают на скрипт (или на ярлык на скрипт) исходную папку с файлами реестра. Ваш путь к файлу с шаблоном чека укажите в переменной strTemplateFile. Целевой каталог, если таковой не существует, будет создан. |
Отправлено: 22:59, 30-10-2018 | #48 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Iska,
Работает! Спасибо! Хотел вот ещё что уточнить, сейчас скрипт округляет сумму до двух знаков после запятой. Используется функция round. Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2 У меня если сумма будет 2,569 то округление должно происходить в большую сторону, тоесть 2, 57 Читал про функцию MRound, но не уверен, что тут она подойдёт |
Отправлено: 07:32, 31-10-2018 | #49 |
Пользователь Сообщения: 60
|
Профиль | Отправить PM | Цитировать Вот пример:
Public Function MatRound#(v#, n&) 'v - округляемое число; 'n - разряд, до которого выполняется округление: ' ... ' -2 - до сотен; ' -1 - до десятков; ' 0 - до единиц (до целых); ' 1 - до десятых; ' 2 - до сотых; ' ... MatRound = Format(v * 10 ^ n, "0") / 10 ^ n End Function |
Отправлено: 09:25, 31-10-2018 | #50 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
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 |
|