[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