Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Разбивка строк общего файла на отдельные csv файлы

Ответить
Настройки темы
VBA - Разбивка строк общего файла на отдельные csv файлы

Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Изменения
Автор: jordan_74
Дата: 03-09-2018
Добрый день всем!! Нужна помощь с написанием макроса.
Имеется 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
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата jordan_74:
Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2 »
Да, это т.н. банковское округление, или округление к ближайшему чётному:
Цитата:
The Round function performs round to even, which is different from round to larger. The return value is the number closest to the value of expression, with the appropriate number of decimal places. If expression is exactly halfway between two possible rounded values, the function returns the possible rounded value whose rightmost digit is an even number. (In a round to larger function, a number that is halfway between two possible rounded values is always rounded to the larger number.)

Round to even is a statistically more accurate rounding algorithm than round to larger.
Это сообщение посчитали полезным следующие участники:

Отправлено: 18:21, 31-10-2018 | #51



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Iska, А можно сделать обычное округление, когда после запятой стоит 5 и выше, округлять в большую сторону, а если меньше 5 то в меньшую?

Отправлено: 21:12, 31-10-2018 | #52


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Попробуйте так (не проверялось):
Код: Выделить весь код
.Range("L3").Value = Fix((anyValue * 18 / 118 + 0.005) * 100) / 100
Это сообщение посчитали полезным следующие участники:

Отправлено: 21:35, 31-10-2018 | #53


Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Изображения
Тип файла: jpg Ошибка.jpg
(105.1 Kb, 2 просмотров)

Iska, Добрый день!
не могу проверить к сожалению, повторяется одна и та же ошибка.
http://forum.oszone.net/attachment.p...1&d=1541579064

Запускаю с рабочего стола, перетаскивая папку с файлами реестра на ярлык скрипта. Сам скрипт и файл шаблона в папке на диске C:

Код вот такой:
Скрытый текст

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 = "C:\Реестр\Шаблон\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 = Fix((anyValue * 18 / 118 + 0.005) * 100) / 100
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

Последний раз редактировалось jordan_74, 07-11-2018 в 11:43.


Отправлено: 11:24, 07-11-2018 | #54


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Проверьте кодировку, в которой сохранён файл скрипта. Она должна быть ANSI/1251.
Это сообщение посчитали полезным следующие участники:

Отправлено: 12:24, 07-11-2018 | #55


Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Цитата Iska:
Проверьте кодировку, в которой сохранён файл скрипта. Она должна быть ANSI/1251. »
Сработало! Хотя до этого никаких манипуляций с кодировкой не делал, и отрабатывало

[q=Iska] у меня огромная просьба встроить в скрипт логирование. Видел варианты, в которых создается лог в случае ошибки. Мне полагается тут нечему ломаться. Нашел вот такой вариант:
Скрытый текст

Const ForAppending = 8
Dim strLogFile, strDate

strDate = Date
strLogFile = "Logs\Find_Primary_" & Year(strDate) & Month(strDate) & Day(strDate) & ".log"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForAppending, True)


objLogfile.WriteLine "Testing my new log file"
objLogFile.Close


Есть вариант как создается за бугром у ребят) https://community.spiceworks.com/scr...-to-a-vbscript

Последний раз редактировалось jordan_74, 07-11-2018 в 12:59.


Отправлено: 12:52, 07-11-2018 | #56


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


jordan_74, это всё замечательно. Но какой в этом смысл в данном-то случае?
Это сообщение посчитали полезным следующие участники:

Отправлено: 13:22, 07-11-2018 | #57


Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Iska,
Способ контроля.Например

Кол-во обработанных строк должно равняться кол-ву созданных чеков;
Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра )

Чтобы если что то потерялось, мы могли понимать сколько было изначально чеков.
Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные.

Отправлено: 13:49, 07-11-2018 | #58


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата jordan_74:
Кол-во обработанных строк должно равняться кол-ву созданных чеков; »
Что тут можно контролировать, если по другому и быть не может:
Код: Выделить весь код
For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2
	…
	objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
Next
?! Не вижу в этом никакого смысла.

Цитата jordan_74:
Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра ) »
Честно сказать, мне это ни о чём не говорит .

Цитата jordan_74:
Чтобы если что то потерялось, »
Количество строк (за вычетом двух) всегда будет совпадать с количеством сгенерированных файлов.

Цитата jordan_74:
Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные. »
Поясните подробнее.

Отправлено: 14:09, 07-11-2018 | #59


Пользователь


Сообщения: 60
Благодарности: 0

Профиль | Отправить PM | Цитировать


Цитата Iska:
Что тут можно контролировать, если по другому и быть не может:
Код:
For i = 1 To objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2

objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
Next
?! Не вижу в этом никакого смысла. »
Это для информации, которая должна быть понятна простому бухгалтеру. Столько то строк реестра отработано-получилось столько то чеков.

Цитата Iska:
Сумма по реестру должна равняться сумме всех сумм в чеках данного реестра ) »
Честно сказать, мне это ни о чём не говорит . »
В файле реестра мы откидываем 2 строки; название столбцов и итоговую сумму по реестру. В каждой "рабочей" строке есть поле сумма, значение которого и копируется в шаблон чека.
Допустим в реестре 40 рабочих строк и общая сумма будет 1600, то при складывании сумм(ячейка H3) в 40 созданных чеках, должно быть тоже 1600

Цитата Iska:
Цитата jordan_74:
Ну и чтобы итоговая сумма совпадала, или расхождения были минимальные. » »
Это тоже самое, что я описал выше

Отправлено: 15:02, 07-11-2018 | #60



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Разбивка строк общего файла на отдельные csv файлы

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
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




 
Переход