Страницы: 1
RSS
Макросом в файлах CSV видоизменить данные
 
Привет всем. Мне надо макрос, который в файлах CSV удалит первую строку, добавит пустую строку и строку со словом, изменит вид даты и заменит разделители (запятые на пробелы).
До сегодняшнего дня двумя макросами видоизменял все файлы TXT в папке. Сегодня перестало выгружаться файлы TXT. Нашелся вариант выгрузки файлов Csv, но имеющийся макрос не подходит. Почему - не знаю.
Заранее благодарю

В приложении файлы тхт было и CSV стало (такой тхт выгружался до сегодня и каким становился файл "Csv стало" после работы макросов). Также еще три файла CSV, которые надо видоизменить в вид файла "Csv стало".
Код
Sub Content_for_etfs_convert()
Kill "D:\Новая папка\IN\*.*"
Kill "D:\Новая папка\OUT\*.*"
  Dim fso
  Set fso = CreateObject("scripting.filesystemobject"):  fso.CopyFolder "E:\downloads1", "D:\Новая папка\IN"

 
Set fso = CreateObject("Scripting.FileSystemObject")
cPath = fso.GetParentFolderName(ThisWorkbook.FullName)
 
cPathIn = cPath & "\In\"
cPathOut = cPath & "\Out\"

Set Folder = fso.GetFolder(cPathIn)
For Each File In Folder.Files
   If fso.GetExtensionName(File.Name) = "txt" Then
      With fso.OpenTextFile(cPathIn & File.Name, 1, True)
         cIn = .ReadAll
         .Close
      End With
      cOut = vbCrLf & "DATE"
      'cOut = "DATE"
      arrL = Split(cIn, vbLf)
      For i = LBound(arrL) To UBound(arrL)
         If Len(arrL(i)) > 0 Then
            arrD = Split(arrL(i), ",")
            arrD(0) = Right(arrD(0), 2) & "." & Mid(arrD(0), 5, 2) & "." & Left(arrD(0), 4)
            For j = 1 To 4
               cnum = Replace(arrD(j), ".", ",")
               arrD(j) = Replace(CStr(Round(CDbl(cnum), 2)), ",", ".")
            Next
            cnum = Replace(arrD(6), ".", ",")
            arrD(6) = Replace(CStr(Round(CDbl(cnum), 0)), ",", ".")
            cOut = cOut & vbCrLf & Join(Array(arrD(0), arrD(1), arrD(2), arrD(3), arrD(4), arrD(6)), vbTab)
         End If
      Next
      With fso.OpenTextFile(cPathOut & File.Name, 2, True)
         .Write cOut
         .Close
      End With
   End If
Next

MsgBox "Ok"

End Sub

Sub replaceTxts()
    Dim fso As New FileSystemObject, curFolder As Folder, curFile As File
    folderPath = "D:\option programs\отбор акций\OUT\"
    Set curFolder = fso.GetFolder(folderPath)
    For Each curFile In curFolder.Files
        If Right(curFile.Path, 4) = ".txt" Then
            curFile.copy Replace(curFile.Path, ".txt", ".csv")
            curFile.Delete
        End If
    Next curFile
End Sub
 
А так работает?
Скрытый текст
 
doober, работает до тех пор, пока не приступит к обработке одного из приложенных файлов в архиве. Далее макрос подсвечивает желтым строку
Код
arrD(j) = Replace(CStr(Round(CDbl(cnum), 2)), ",", ".")
Когда выгружало в TXT, то пустые строки не записывались, как в ADPT.txt  . В CSV строки с null-ами, как оказалось, остаются. Есть ли возможность эти строки не записывать в измененном файле?
Изменено: Виктор А - 22.03.2020 07:18:26
 
Вы данные в файле смотрели, там null
Код
arrD(j) = Replace(CStr(Round(Val(cnum), 2)), ",", ".")
 
Цитата
doober написал:
данные в файле смотрели, там null
Да, теперь там есть строки с null. И их надо как-то обойти

doober, по сути, Вы сделали нужный макрос. Спасибо большое

Нужно перед работой этого макроса другим макросом удалить все строки, в которых встречается null. Позже открою еще тему
 
Сначала создаем себе геморрой, потом пытаемся вылечить.
Может пропустить этот шаг?
Код
            For j = 1 To 4
               arrD(j) = CStr(Round(Val(arrD(j)), 2))
            Next
            arrD(6) = CStr(Round(Val(arrD(6)), 0))


Цитата
Виктор А написал:
Нужно перед работой этого макроса другим макросом удалить все строки, в которых встречается null
Зачем?
         
Код
 For i = LBound(arrL) To UBound(arrL)
                If Len(arrL(i)) > 0 Then
                    arrD = Split(arrL(i), ",")
                    If Not IsNull(arrD(6)) Then
                        arrD(0) = Right(arrD(0), 2) & "." & Mid(arrD(0), 5, 2) & "." & Left(arrD(0), 4)
                        For j = 1 To 4
                            arrD(j) = CStr(Round(Val(arrD(j)), 2))
                        Next
                        arrD(6) = CStr(Round(Val(arrD(6)), 0))
                        cOut = cOut & vbCrLf & Join(Array(arrD(0), arrD(1), arrD(2), arrD(3), arrD(4), arrD(6)), vbTab)
                    End If
                End If
            Next
Изменено: RAN - 22.03.2020 11:48:42
 
RAN, добавил Ваши строки. Получилось так
Код
         If Len(arrL(i)) > 0 Then
            arrD = Split(arrL(i), ",")
            arrD(0) = Format(CDate(arrD(0)), "dd.MM.yyyy")
            
            For j = 1 To 4
               arrD(j) = CStr(Round(Val(arrD(j)), 2))
            Next
            arrD(6) = CStr(Round(Val(arrD(6)), 0))
            
            cOut = cOut & vbCrLf & Join(Array(arrD(0), arrD(1), arrD(2), arrD(3), arrD(4), arrD(6)), vbTab)
         End If
Отработало все файлы. Спасибо большое

Цитата
RAN написал:
Зачем?
У меня макросов штук тридцать. Запускаю по очереди. Поэтому хотел, раз произошел сбой с выгрузкой и теперь другая выгрузка в CSV, после изменений получить точно такие же данные, как и до этого сбоя. Сейчас строки с нулями остаются, посмотрю что будет на выходе. Если понадобится, то все таки буду удалять эти строки с нулями.  
Страницы: 1
Наверх