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

[jordan_74]

Добрый день всем!! Нужна помощь с написанием макроса.
Имеется 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

[Iska]

Надеюсь понятно объяснил) »
Не совсем. Первым делом от Вас требовалось создать образцы всех этих файлов:
Имеется 3 папки Шаблон, Реестр и Итог
В папке Реестр лежит исходный файл excel с данными. В папке шаблон лежит файл с именем check формата csv, который планируется использовать в качестве шаблона.
…
То есть если в исходном файле условно 50 строк, то должно получиться 49 чеков(в последнюю строку исходного файла выводится общая сумма, она не нужна) Имена файлов в папке итог должны быть от check1 до условно check49»
упаковать их в архив и приложить к сообщению.

[jordan_74]

Iska,

Архив с примерами файлов приложил

[Iska]

Архив с примерами файлов приложил »
jordan_74, простите, я не вижу ни единого образца результирующего файла в каталоге Итог.

[jordan_74]

Iska,

Прошу прощения
http://forum.oszone.net/attachment.php?attachmentid=153992&stc=1&d=1535984169

[Iska]

Прошу прощения
http://forum.oszone.net/attachment.p...1&d=1535980430 »
Страница не найдена. Если вы уверены, что использовали правильную ссылку, свяжитесь с администрацией

[jordan_74]

Iska,http://forum.oszone.net/attachment.php?attachmentid=153992&stc=1&d=1535984169

[Iska]

jordan_74, в примере Вашего файла присутствует явное округление — 152,5 вместо 152,5423729. Что Вы можете пояснить по этому поводу?

Макрос VBA:
Option Explicit

Sub Sample()
Dim strTemplateFile As String
Dim strSourceFile As String
Dim strDestFolder As String


Dim objFSO As Object

Dim objTemplateFile As Workbook
Dim objSourceFile As Workbook

Dim i As Long
Dim strDestFile As String

Dim anyValue As Variant


strTemplateFile = "C:\Мои проекты\0191\Архив\Архив\Шаблон\check.csv"
strSourceFile = "C:\Мои проекты\0191\Архив\Архив\Реестр\26.08.2018_38490,25.xlsx"
strDestFolder = "C:\Мои проекты\0191\Архив\Архив\Итог"

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(strTemplateFile) Then
If objFSO.FileExists(strSourceFile) Then
If objFSO.FolderExists(strDestFolder) Then
Application.DisplayStatusBar = True
Application.ScreenUpdating = False

Application.Workbooks.OpenText Filename:=strTemplateFile, Local:=True
Set objTemplateFile = Application.Workbooks.Item(objFSO.GetFileName(strTemplateFile))

Set objSourceFile = Application.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 = (anyValue * 18) / 118
End With

strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & CStr(i) & "." & objFSO.GetExtensionName(strTemplateFile))

Application.StatusBar = "Creating [" & strDestFile & "]…"

If objFSO.FileExists(strDestFile) Then
objFSO.DeleteFile strDestFile, True
End If

objTemplateFile.SaveAs Filename:=strDestFile, FileFormat:=xlCSV, Local:=True
Next

objSourceFile.Close False
objTemplateFile.Close False

Application.ScreenUpdating = True
Application.StatusBar = False
Else
MsgBox "Can't find destination folder [" & strDestFolder & "].", vbExclamation + vbOKOnly, "Can't find destination folder"
End If
Else
MsgBox "Can't find source file [" & strSourceFile & "].", vbExclamation + vbOKOnly, "Can't find source file"
End If
Else
MsgBox "Can't find template file [" & strTemplateFile & "].", vbExclamation + vbOKOnly, "Can't find template file"
End If
End Sub



На 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"
strSourceFile = "C:\Мои проекты\0191\Архив\Архив\Реестр\26.08.2018_38490,25.xlsx"
strDestFolder = "C:\Мои проекты\0191\Архив\Архив\Итог"

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 = (anyValue * 18) / 118
End With

strDestFile = objFSO.BuildPath(strDestFolder, objFSO.GetBaseName(strTemplateFile) & CStr(i) & "." & 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
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
WScript.Quit 3
End If
Else
WScript.Echo "Can't find source file [" & strSourceFile & "]."
WScript.Quit 2
End If
Else
WScript.Echo "Can't find template file [" & strTemplateFile & "]."
WScript.Quit 1
End If

WScript.Quit 0

[jordan_74]

Iska,так и есть, один знак после запятой, таков формат данных в ячейке

[jordan_74]

Все работает как надо.
strSourceFile = "C:\Мои проекты\0191\Архив\Архив\Реестр\26.08.2018_38490,25.xlsx" »
Единственный момент, можно ли сделать без привязки к конкретному файлу реестра? Таких реестров может быть до 10 штук в день.
Тогда возникнет путаница с нумерацией чеков.... Возможно к имени чека помимо нумерации нужно добавлять имя файла реестра, что то типа check_26.08.2018_38490,25_001

[Iska]

Iska,так и есть, один знак после запятой, таков формат данных в ячейке »
jordan_74, не может такого быть, мы говорим о содержимом ячейки, а не о формате. Мы можем округлять до какого-либо знака после запятой, если требуется. Надо?

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

[Iska]

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. И что с округлением — делаем, не делаем? Делаем!

[jordan_74]

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

[Iska]

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

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

[jordan_74]

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

[Iska]

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

[jordan_74]

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

[Iska]

или все таки можно сделать обычным двойным кликом? »
Так было ж «обычным двойным кликом» чуть выше (http://forum.oszone.net/post-2829774.html#post2829774). Вы захотели, чтобы можно было работать с разными исходными файлами. Как скрипт будет узнавать, с каким именно исходным файлом ему следует работать?!

[jordan_74]

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

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

[Iska]

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