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

Компьютерный форум 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:
Надеюсь понятно объяснил) »
Не совсем. Первым делом от Вас требовалось создать образцы всех этих файлов:
Цитата jordan_74:
Имеется 3 папки Шаблон, Реестр и Итог
В папке Реестр лежит исходный файл excel с данными. В папке шаблон лежит файл с именем check формата csv, который планируется использовать в качестве шаблона.

То есть если в исходном файле условно 50 строк, то должно получиться 49 чеков(в последнюю строку исходного файла выводится общая сумма, она не нужна) Имена файлов в папке итог должны быть от check1 до условно check49»
упаковать их в архив и приложить к сообщению.
Это сообщение посчитали полезным следующие участники:

Отправлено: 17:25, 02-09-2018 | #2



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

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


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


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

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


Вложения
Тип файла: 7z Архив.7z
(9.1 Kb, 3 просмотров)

Iska,

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

Отправлено: 10:22, 03-09-2018 | #3


Ветеран


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

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


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

Отправлено: 15:53, 03-09-2018 | #4


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


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

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


Iska,

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

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


Отправлено: 16:12, 03-09-2018 | #5


Ветеран


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

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


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

Отправлено: 16:18, 03-09-2018 | #6


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


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

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


Вложения
Тип файла: rar Архив.rar
(9.4 Kb, 7 просмотров)

Iska,http://forum.oszone.net/attachment.p...1&d=1535984169

Отправлено: 17:17, 03-09-2018 | #7


Ветеран


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

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


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
Это сообщение посчитали полезным следующие участники:

Отправлено: 22:29, 03-09-2018 | #8


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


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

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


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

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


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


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

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


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

Отправлено: 10:15, 04-09-2018 | #10



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




 
Переход