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

Компьютерный форум 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:
Iska,так и есть, один знак после запятой, таков формат данных в ячейке »
jordan_74, не может такого быть, мы говорим о содержимом ячейки, а не о формате. Мы можем округлять до какого-либо знака после запятой, если требуется. Надо?

Цитата jordan_74:
Единственный момент, можно ли сделать без привязки к конкретному файлу реестра? Таких реестров может быть до 10 штук в день.
Тогда возникнет путаница с нумерацией чеков.... Возможно к имени чека помимо нумерации нужно добавлять имя файла реестра, что то типа check_26.08.2018_38490,25_001 »
Мы можем сделать так: будет жёсткая привязка к местоположению шаблона (strTemplateFile), будет жёсткая привязка к метоположению выходных файлов (strDestFolder), а путь к исходному файлу (strSourceFile) мы будем указывать параметром скрипта WSH — тогда Вы сможете просто перетаскивать любой исходный файл реестра на скрипт WSH в Проводнике. Такое Вас устроит, делаем?
Это сообщение посчитали полезным следующие участники:

Отправлено: 16:24, 04-09-2018 | #11



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

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


Ветеран


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

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

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

P.S. И что с округлением — делаем, не делаем? Делаем!

Последний раз редактировалось Iska, 04-09-2018 в 19:17. Причина: Добавил указанное округление

Это сообщение посчитали полезным следующие участники:

Отправлено: 18:29, 04-09-2018 | #12


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


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

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


Цитата Iska:
P.S. И что с округлением — делаем, не делаем? »
Округление до одного знака после запятой, да

Отправлено: 18:50, 04-09-2018 | #13


Ветеран


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

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


Цитата jordan_74:
Округление до одного знака после запятой, да »
Добавил в предыдущий код, пробуйте.

P.S. Забыл самое главное — одноимённые файлы, уже существующие в целевом каталоге, будут молча перезаписаны (точнее — удалены, а на их место будут записаны новые файлы).
Это сообщение посчитали полезным следующие участники:

Отправлено: 19:17, 04-09-2018 | #14


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


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

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


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

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
Благодарности: 8086

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


Цитата jordan_74:
сохранил в формате .js но при запуске возникла ошибка, может я что то криво сделал »
Поправьте пути на свои, сохраните файл с расширением .vbs, а затем попробуйте перетащить на него файл реестра.
Это сообщение посчитали полезным следующие участники:

Отправлено: 20:37, 04-09-2018 | #16


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


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

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


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

Iska,
Сохранил в формате .vbs
Отработало как надо. Вопрос, нужно именно перетаскивать файл реестра на скрипт, или все таки можно сделать обычным двойным кликом?

Последний раз редактировалось jordan_74, 04-09-2018 в 21:16.


Отправлено: 20:43, 04-09-2018 | #17


Ветеран


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

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


Цитата jordan_74:
или все таки можно сделать обычным двойным кликом? »
Так было ж «обычным двойным кликом» чуть выше. Вы захотели, чтобы можно было работать с разными исходными файлами. Как скрипт будет узнавать, с каким именно исходным файлом ему следует работать?!
Это сообщение посчитали полезным следующие участники:

Отправлено: 21:27, 04-09-2018 | #18


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


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

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


Цитата Iska:
Как скрипт будет узнавать, с каким именно исходным файлом ему следует работать?! »
Я не знаю) с VBA я ещё как то знаком, а вот с wsh совершенно нет.

Тем не менее огромное спасибо Iska, вы очень помогли и облегчили работу многим людям. У меня финальная просьба, т.к я с wsh вообще не знаком, могли бы прокомментировать блоки кода, чтобы понять что делается на разных этапах..!?

Отправлено: 06:51, 05-09-2018 | #19


Ветеран


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

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


Цитата jordan_74:
У меня финальная просьба, т.к я с wsh вообще не знаком, могли бы прокомментировать блоки кода, чтобы понять что делается на разных этапах..!? »
Постараюсь сделать вечером.
Это сообщение посчитали полезным следующие участники:

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



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




 
Переход