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

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

Цитата jordan_74:

Надеюсь понятно объяснил) »

Не совсем. Первым делом от Вас требовалось создать образцы всех этих файлов:

Цитата jordan_74:

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

упаковать их в архив и приложить к сообщению.

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

Iska,

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

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

Цитата jordan_74:

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

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

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

Iska,

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

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

Цитата jordan_74:

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

Цитата:

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

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

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

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

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 · Отправлено: **05:12, 04-09-2018** | #9

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

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

Все работает как надо.

Цитата Iska:

strSourceFile = "C:\Мои проекты\0191\Архив\Архив\Реестр\26.08.2018_38490,25.xlsx" »

Единственный момент, можно ли сделать без привязки к конкретному файлу реестра? Таких реестров может быть до 10 штук в день.
Тогда возникнет путаница с нумерацией чеков.... Возможно к имени чека помимо нумерации нужно добавлять имя файла реестра, что то типа check_26.08.2018_38490,25_001