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

Компьютерный форум 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

 

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


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

Профиль | Отправить 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
Благодарности: 8086

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


jordan_74, я могу лишь повторить свой вопрос — как Вы это видите?

Отправлено: 20:46, 30-10-2018 | #42


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


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

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


Iska, Файл скрипта и шаблон чека находятся в отдельных папка в сети.
У пользователя папка с файлом реестра и папка с целевыми файлами чеков, а также исполнительный файл, который запускает процесс преобразования.

Пользователь запускает условно батник, который запускает в работу скрипт, лежащий в сети. Скрипт обрабатывает файл реестра и складывает готовые файлы чека в итоговую папку.

Как конкретно это реализовать откровенно говоря не знаю (

Отправлено: 21:09, 30-10-2018 | #43


Ветеран


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

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


Цитата jordan_74:
и папка с целевыми файлами чеков »
Путь к ней будет одинаков для любых пользователей на любых машинах? Или же мы будем её располагать относительно:
Цитата jordan_74:
папка с файлом реестра »
?

Отправлено: 21:55, 30-10-2018 | #44


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


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

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


Цитата Iska:
Путь к ней будет одинаков для любых пользователей на любых машинах? Или же мы будем её располагать относительно: »
Нужно располагать относительно, как и папку с файлом реестра

Отправлено: 22:07, 30-10-2018 | #45


Ветеран


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

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


Цитата jordan_74:
Нужно располагать относительно »
И как именно?

Например, каталог с файлами реестра располагается в «C:\Мои проекты\0191\Архив\Архив\Реестр». Тогда скрипт будет предполагать наличие каталога для целевых файлов рядом с каталогом с файлами реестра, т.е, относительно каталога с файлами реестра — как «..\Итог», что в данном конкретном случае отобразится на каталог «C:\Мои проекты\0191\Архив\Архив\Итог».

Или же: «C:\Моя папка\Мой Реестр» и, соответственно — «C:\Моя папка\Итог».

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

Цитата jordan_74:
как и папку с файлом реестра »
А это как?!

Отправлено: 22:22, 30-10-2018 | #46


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


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

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


Цитата Iska:
Скрипт даже может сам создавать каталог для целевых файлов, буде таковое потребно. »
Здесь полностью согласен.

Я имел ввиду что каталог с целевыми файлами предполагает наличие рядом каталога с файлами реестра, именно так

Отправлено: 22:27, 30-10-2018 | #47


Ветеран


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

Профиль | Отправить 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
Благодарности: 0

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


Iska,
Работает! Спасибо!
Хотел вот ещё что уточнить, сейчас скрипт округляет сумму до двух знаков после запятой.
Используется функция round. Но я так понял, что это обычное бухгалтерское округление тоесть Round(2,5) = 2
У меня если сумма будет 2,569 то округление должно происходить в большую сторону, тоесть 2, 57

Читал про функцию MRound, но не уверен, что тут она подойдёт

Отправлено: 07:32, 31-10-2018 | #49


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


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

Профиль | Отправить 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



Компьютерный форум 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




 
Переход