Макрос форматирования Excel CSV

Question

Я пытаюсь экспортировать несколько рабочих листов в виде файла c csv с очень точным форматированием c для подачи в стороннее программное обеспечение (PJe Cal c Cidadão).

PJe принимает записанные файлы в следующем формате:

"MES_ANO";"VALOR";"FGTS";"FGTS_REC.";"CONTRIBUICAO_SOCIAL";"CONTRIBUICAO_SOCIAL_REC."
"10/2012";"500,00";"S";"S";"S";"S"
"01/2013";"500,00";"S";"N";"S";"N" 

Я могу добиться этого форматирования, объединяя отформатированные значения в одном столбце таблицы и сохраняя его как CSV, но как только я открываю CSV вне Excel, он форматируется как:

"""MES_ANO"";""VALOR"";""FGTS"";""FGTS_REC."";""CONTRIBUICAO_SOCIAL"";""CONTRIBUICAO_SOCIAL_REC."""
"""12/2015"";""1000,00"";""N"";""N"";""N"";""N"""
"""01/2016"";""1000,00"";""N"";""N"";""N"";""N"""

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

Любой советы?

Answer 1

Предполагая, что вы хотите экспортировать столбцы от A до F на всех листах рабочей книги, чтобы разделить CSV-файлы с кодировкой Unicode, попробуйте это;

    Option Explicit

    Sub exportcsv()

        Const LAST_COL = 6
        Const DELIM = ";"
        Const QUOTE = """"

        Dim wb As Workbook, ws As Worksheet
        Dim iRow As Long, iLastRow As Long, s As String, c As Integer, count As Integer
        Dim oFSO As Object, oFS As Object
        Dim sPath As String, sCSVfile As String

        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set wb = ThisWorkbook
        sPath = wb.path & "\"

        For Each ws In wb.Sheets
            count = 0
            sCSVfile = "Sheet_" & ws.Index & ".csv"
            Set oFS = oFSO.CreateTextFile(sPath & sCSVfile, True, True) 'overwrite, Unicode

            iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
            For iRow = 1 To iLastRow
                s = ""
                For c = 1 To LAST_COL
                    If c > 1 Then s = s & DELIM
                    s = s & QUOTE & ws.Cells(iRow, c) & QUOTE
                Next
                oFS.writeline s
                count = count + 1
            Next
            oFS.Close
            Debug.Print sCSVfile, count
        Next
        MsgBox "CSV files exported to " & sPath, vbInformation, "Finished"
    End Sub