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

Компьютерный форум 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:
Это для информации, которая должна быть понятна простому бухгалтеру. Столько то строк реестра отработано-получилось столько то чеков. »
Ну, добавьте выделенное:
Код: Выделить весь код
							objTemplateFile.SaveAs strDestFile, xlCSV, , , , , , , , , , True
						Next
						
						WScript.Echo "Total rows processed: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2)
						
						objSourceFile.Close False
Цитата jordan_74:
Допустим в реестре 40 рабочих строк и общая сумма будет 1600, то при складывании сумм(ячейка H3) в 40 созданных чеках, должно быть тоже 1600 »
Естественно. И в этом случае по другому быть тоже не может. Не может оно никак «потеряться». И расхождений тут быть не может. Никаких — ни минимальных, ни максимальных.
Это сообщение посчитали полезным следующие участники:

Отправлено: 05:55, 08-11-2018 | #61



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

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


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


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

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


Цитата Iska:
WScript.Echo "Total rows processed: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2) »
Я так полагаю эта строчка выдает сообщение сколько строк обработано по каждому из реестров?

Можно ли сделать, чтобы данные записывались в лог файл в формате txt* ?

Отправлено: 13:39, 08-11-2018 | #62


Ветеран


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

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


Цитата jordan_74:
Я так полагаю эта строчка выдает сообщение сколько строк обработано по каждому из реестров? »
Да.

Цитата jordan_74:
Можно ли сделать, чтобы данные записывались в лог файл в формате txt* ? »
Можно. Но позже.

Отправлено: 14:17, 08-11-2018 | #63


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


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

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


Iska,
хорошо

Отправлено: 18:56, 08-11-2018 | #64


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


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

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


Iska, День добрый! С логированием разобрался, с горем пополам.
Хочу сделать проверку, в ситуации когда папка с файлами реестра пуста, чтобы выводилось сообщение об этом.

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

Скрытый текст

Option Explicit

Const xlCSV = 6
Const xlWindows = 2

Dim Log 'Лог-файл


Dim strSourceFolder
Dim strSourceFile

Dim strTemplateFile

Dim strRelativeDestFolder
Dim strDestFolder

Dim strLogDestFolder 'Папка, в которой будут создаваться лог-файлы

Dim objFSO
Dim objExcel

Dim objFolder
Dim colFiles

Dim objFile

Dim objTemplateFile
Dim objSourceFile

Dim i
Dim strDestFile

Dim strLogDestFile

Dim SumSourceFile 'Сумма по реестру
Dim SumDestFile 'Сумма по чекам
Dim SumTotal 'Общая сумма

Dim CountSourceFiles 'Для подсчета файлов реестра
CountSourceFiles = 0

Dim anyValue

'Здесь указать полный адрес папки с файлами реестра:
strSourceFolder = "C:\Реестр\Реестр"


strTemplateFile = "C:\Реестр\Шаблон\check.csv"
strRelativeDestFolder = "..\Итог"
strLogDestFolder = "C:\Касса"

'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
If objFSO.FileExists(objSourceFile) Then

strDestFolder = objFSO.GetAbsolutePathName(objFSO.BuildPath(strSourceFolder, strRelativeDestFolder))
If Not objFSO.FolderExists(strDestFolder) Then
objFSO.CreateFolder strDestFolder
End If

'Создание папки Касса:
If Not objFSO.FolderExists(strLogDestFolder) Then
objFSO.CreateFolder strLogDestFolder
End If

Set objExcel = Nothing

For Each objFile In objFSO.GetFolder(strSourceFolder).Files

'Подсчет количества файлов реестра:
CountSourceFiles = CountSourceFiles + 1

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

'Подсчет общей суммы:
SumTotal = SumTotal + anyValue

'Подсчет суммы по реестру:
SumSourceFile = SumSourceFile + anyValue

'Подсчет суммы по чекам:
SumDestFile = SumDestFile + .Range("H3").Value

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

'В strLogDestFile записывается где будет создан лог-файл и как он будет называться:
strLogDestFile = objFSO.BuildPath(strLogDestFolder, Day(now) & "_" & Month(now) & "_" & Year(now) & ".txt")

'Открытие лог-файла или создание, если его нет:
Set Log = objFSO.OpenTextFile(strLogDestFile, 8, True)
'Запись данных в лог-файл:
Log.Write FormatDateTime(now, 0) 'В лог записывается дата и время обработки файлов
Log.Write ". Обработан файл " & objFSO.GetBaseName(objFile.Name) & "." & objFSO.GetExtensionName(objFile.Name)
Log.Write ". Строк обработано: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2)
Log.Write ". Чеков создано: " & CStr(objSourceFile.Worksheets.Item(1).UsedRange.Rows.Count - 2)
Log.Write ". Сумма по реестру: " & SumSourceFile
Log.Write ". Сумма по чекам: " & SumDestFile
'Сравнение сумм по реестру и чекам - если они равны, то это записывается в лог
If SumSourceFile = SumDestFile Then
Log.Write ". Суммы равны."
End If
Log.WriteBlankLines(1)
Log.Close

'Обнуление сумм, чтобы для каждого файла реестра и его чеков считалась своя отдельная сумма
SumSourceFile = 0
SumDestFile = 0

objSourceFile.Close False
objTemplateFile.Close False
End Select
Next

If Not objExcel Is Nothing Then
objExcel.Quit
Set objExcel = Nothing
End If

' Очищение папки Реестр
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(strSourceFolder)
Set colFiles = objFolder.Files

For Each objFolder in colFiles
objFolder.Delete

next

'Выводит окно о завершении обработки файлов:
WScript.Echo "Чеки сформированы успешно. Обработано " & CountSourceFiles & " реестра на сумму " & SumTotal & "."

Else
WScript.Echo "Нет файла реестра [" & strSourceFile & "]."
WScript.Quit 3
End if
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 2
End If

Set objFSO = Nothing

Else
WScript.Echo "Can't find template file [" & strTemplateFile & "]."
WScript.Quit 1
End If


'Else
' WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"
' WScript.Quit 1
'End If

WScript.Quit 0


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


Отправлено: 08:50, 22-11-2018 | #65



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




 
Переход