Страницы: 1
RSS
Объединить файлы csv в один
 
Добрый день.
В просторах интернета не смог найти макроса для что бы "сцепить" несколько файлов csv в один (нашел примеры с xls - очень крутой, запускаешь макрос и он обьденяет фалы которые ты сам выбреешь в проводнике записывает их друг под другом)
Возможно у Вас есть примеры подобного и для csv.

 
Изменено: Marat_Mamedov - 08.09.2016 10:16:54
 
Код
copy /b *.csv all.csv
это командная строка.
 
Нашел на просторах интернета (немого подкрутил вроде работает)
Может кому пригодиться

Код
Option Explicit

Sub SCV_and_Sheets1()
    Dim iBeginRange As Object, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean
    
    On Error Resume Next
    'Выбираем диапазон выборки с книг
    Set iBeginRange = Range("A1")
    'Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    'для указания диапазона без диалогового окна:
    'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
    'Если диапазон не выбран - завершаем процедуру
    'If iBeginRange Is Nothing Then Exit Sub
    
    'Указываем имя листа
    'Допустимо указывать в имени листа символы подставки ? и *.
    'Если указать только * то данные будут собираться со всех листов
    'If sSheetName = "" Then sSheetName = "*"sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    'Если имя листа не указано - данные будут собраны со вех листов
    'If sSheetName = "" Then sSheetName = "*"
    
    sSheetName = "*"
    On Error GoTo 0
    'Запрос - вставлять на результирующий лист все данные
    'или только значения ячеек (без формул и форматов)
    bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes)
    'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги)
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.csv*),*.csv*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    'отключаем обновление экрана, автопересчет формул и отслеживание событий
    'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    'создаем новый лист в книге для сбора
    Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    'если нужно сделать сбор данных на новый лист книги с кодом
    'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    'цикл по книгам
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(filename:=avFiles(li))
        Else
            Set wbAct = ThisWorkbook
        End If
        oAwb = wbAct.Name
        'цикл по листам
        For Each wsSh In wbAct.Sheets
            If wsSh.Name Like sSheetName Then
                'Если имя листа совпадает с именем листа, в который собираем данные
                'и сбор идет только с активной книги - то переходим к следующему листу
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1 'собираем данные начиная с указанной ячейки и до конца данных
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else 'собираем данные с фиксированного диапазона
                        sCopyAddress = iBeginRange.Address
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                    'вставляем имя книги, с которой собраны данные
                    If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = oAwb
                    If bPasteValues Then 'если вставляем только значения
                        .Range(sCopyAddress).Copy
                        wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues
                    Else
                        .Range(sCopyAddress).Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
                    End If
                End With
            End If
NEXT_:
        Next wsSh
        Application.DisplayAlerts = False
        If bPolyBooks Then wbAct.Close False
    Next li
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
    End With

 Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
End Sub
 
xlLastCell в общем случае может "косячить", но с csv должно быть нормально.
Чем отличается результат работы командной строки и этого монстра?
 
Цитата
Hugo написал: Чем отличается результат работы командной строки и этого монстра?
Думаю, что ничем (честно, не проверял), зато выглядит внушительней. :)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Отличие могу только одно назвать - можно указать другую начальную ячейку, исключив шапку. Плюс этот код изначально был рассчитан на сбор данных с Excel-файлов и при сборе с CSV можно бяку с разделителями получить.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
В моем случаи все работает на ура ))
Не смог отключить прописания в первой колонке название файла, и он вставляет со второй ячейки
но это дело все удаляю в конце и все хорошо (еще вставил отключение диалогового окна  буфера обмена)
 
Код мой, поэтому подсказать могу. Чтобы имя книги не вставлялось достаточно в этом куске кода:
Код
If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.csv*),*.csv*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 1
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If

установить lCol = 0
Изменено: The_Prist - 08.09.2016 17:23:49
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Спасибо!
Код просто супер!
 
Код-то супер, но вот эксель не супер, часто норовит открывать csv так, как ему вздумается.
Тщательно проверьте результат на соответсвие исходным файлам, и обязательно в текстовом редакторе!
 
добрый день. можно узнать,при значении строки 13 --- Set iBeginRange = Range("A1:A400") ---  в коде макроса из сообщения #3  данные из файлов CSV  переносятся на диапазоны, начинающиеся с каждой четырехсотой строки по счету. есть ли возможность учитывать не строки, а столбцы? например, переносить данные из каждого файла CSV в тринадцатые по счету столбцы.  
 
Цитата
Marat_Mamedov написал:
Нашел на просторах интернета (немого подкрутил вроде работает) Может кому пригодиться
Подскажите пожалуйста, код файлы объединяет.
Здесь все отлично.

Но у меня проблема, после выполнения макроса, нарушается разметка, https://c2n.me/49nbYYj
Это можно как-то поправить?
Изменено: mazersw - 09.10.2020 10:22:15
 
Это можно поправить командной строкой :)
Хотя по скрину не лечим, и что там нарушено - без понятия...
Но командная строка из первого ответа точно ничего не сломает.
 
Цитата
Hugo написал:
Это можно поправить командной строкой
Командной строкой не очень удобно
 
Цитата
mazersw написал:
нарушается разметка,
писалось выше в теме, что в случае с CSV эта проблема может присутствовать. Чтобы исправить, попробуйте эту строку:
Код
Workbooks.Open(filename:=avFiles(li))
записать так:
Код
Workbooks.OpenText(filename:=avFiles(li), local:=True)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Код
Workbooks.OpenText(filename:=avFiles(li), local:=True)
Спасибо работает!
Изменено: mazersw - 09.10.2020 13:56:08
 
После выполнения макроса, настроил автоматическое сохранение:
Код
  ActiveWorkbook.SaveAs FileFormat:=xlCSV, CreateBackup:=False, local:=True
Но не пойму как задать имя файлу, добавляю filename:=название.csv
Выходит ошибка.
 
Цитата
mazersw написал:
не пойму как задать имя файлу
а зачем вообще это? И в каком месте Вы это нашли вообще?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
а зачем вообще это? И в каком месте Вы это нашли вообще?
Необходимо, чтобы после выполнения макроса слияния файл сразу сохранялся автоматом.
Макрос я записал, при сохранении файла.
 
Цитата
Marat_Mamedov написал:
Нашел на просторах интернета (немого подкрутил вроде работает) Может кому пригодиться
А можно ли как-то пропустить первый два шага вопроса?
Т.е. чтобы сразу можно было выбирать файлы
 
Цитата
mazersw написал:
чтобы после выполнения макроса слияния файл сразу сохранялся автоматом
для этого как минимум необходимо, чтобы макрос находился не в той же книге, что и итоговая.
Цитата
mazersw написал:
А можно ли как-то пропустить первый два шага вопроса?
они и так там пропущены, это раз.
Два - раз так много лишнего проще вообще другой код использовать: Как объединить несколько текстовых файлов в один?
замените там расширение на .csv и все. Правда, если первые строки надо исключить - придется немного пошаманить с переменной sTxt(перебрать циклом с только нужной строки).
Изменено: Дмитрий(The_Prist) Щербаков - 12.10.2020 11:34:03
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
спасибо.
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Два - раз так много лишнего проще вообще другой код использовать:  Как объединить несколько текстовых файлов в один? замените там расширение на .csv и все.
Добрый день.
Подскажите, пож, объединяю большие csv файлы (11 000 столбцов и 250 строк в каждом, размер по +-5,63 мб). После 379 файла ошибка "Out of string  space". Думал может ошибка в самом 379 файле - удалил его - все по прежнему на 379 файле вылетает ошибка. В диспетчере задач объем памяти занятой этим процессом 4,2 гб (а у меня доступно 14)
Бьюсь второй день, пробовал чтобы сразу запись шла, а не в конце большой текст писался. пробовал Open ... For Append As #1... но видимо руки корявые... не получается ничего
 
Ливиан, здравия. Через командную строку пробовали? Или Вам именно через ВБА надо?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
мне бы макросом, я его встрою в другие макросы, будет непрерывная операция...  
 
Можете в макросе выполнить стандартную команду для копирования нескольких файлов в один, например, через функцию Shell.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Код
pachb = Application.CurrentProject.Path
path1 = pachb & "\Отсюда\"
path2 = pachb & "\Сюда\" 
Call Shell("cmd /c copy """ & path1 & "*.csv"" """ & path2 & "Объединенный.csv""")

что то вроде этого? пишут что с шапкой проблема... сейчас посижу покумекаю, может что получится. Спасибо за наводку... если не получится напишу еще
 
Ливиан, если не получится, то приложите пару исходных файлов-примеров с шапкой и один файл, что из их объединения должно получиться. (примеры сделайте обезличенными согласно правил форума)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Цитата
JayBhagavan написал:
через функцию  Shell .
+
Цитата
Ливиан написал:
я его встрою в другие макросы, будет непрерывная операция...  
и получим синхронную работу с возможно не предсказуемым результатом

Shell да другой  
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх