Как я могу объединить или прочитать CSV-файлы с переносами строк / возврат каретки (CR) в Excel VBA? - PullRequest
Новая
       10

Как я могу объединить или прочитать CSV-файлы с переносами строк / возврат каретки (CR) в Excel VBA?

0 голосов
/ 03 января 2019

Я использовал очень простое и практичное решение из Объединение файлов CSV с помощью макроса , который считывает и объединяет файлы CSV с помощью команды Line. Проблема возникает, если некоторые CSV-файлы содержат разрывы (возврат каретки), тогда команда Line считывает эти данные в отдельные строки, а не в одну.

Данные CSV в Excel выглядят так:

CSV data with break lines (carriage return)

Данные в файле .CSV выглядят так:

Name;Surname;Book Title Jan;Zitniak;"Microsoft Excel 2019 for beginners and intermediates" Tiya;Solomon;"Be happy every day in your life!" Ianis;Tillman;"Honor and the Noble Heart"

Примечание: в моем .CSV я использую точку с запятой вместо запятой в качестве разделителя. Обратите внимание на двойные кавычки в данных с линиями разрыва.

.CSV файл для загрузки здесь .

EDIT:

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

Спасибо за любую помощь.

1 Ответ

0 голосов
/ 03 января 2019

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

Option Explicit

Sub Macro1()
    Dim ff As Integer, str As String, fname As String

    fname = Environ("USERPROFILE") & "\Downloads\csv-with-carriage-return.csv"

    ff = FreeFile
    Open fname For Input As ff
    str = Input(LOF(ff), ff)
    Close ff

    str = Replace(str, Chr(32) & Chr(13) & Chr(10), Chr(124))

    ff = FreeFile
    Open fname For Output As ff
    Print #ff, str
    Close ff

    Workbooks.OpenText Filename:=fname, Origin:=65001, DataType:=xlDelimited, _
                       Semicolon:=True, Tab:=False, Comma:=False, Space:=False, Other:=False, _
                       FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2))

    With ActiveWorkbook

        .Worksheets(1).Columns(3).Cells.Replace what:=Chr(124), replacement:=Chr(32) & Chr(10)

    End With

End Sub
...