Добрый день. В просторах интернета не смог найти макроса для что бы "сцепить" несколько файлов csv в один (нашел примеры с xls - очень крутой, запускаешь макрос и он обьденяет фалы которые ты сам выбреешь в проводнике записывает их друг под другом) Возможно у Вас есть примеры подобного и для 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
Отличие могу только одно назвать - можно указать другую начальную ячейку, исключив шапку. Плюс этот код изначально был рассчитан на сбор данных с 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
Код-то супер, но вот эксель не супер, часто норовит открывать csv так, как ему вздумается. Тщательно проверьте результат на соответсвие исходным файлам, и обязательно в текстовом редакторе!
добрый день. можно узнать,при значении строки 13 --- Set iBeginRange = Range("A1:A400") --- в коде макроса из сообщения #3 данные из файлов CSV переносятся на диапазоны, начинающиеся с каждой четырехсотой строки по счету. есть ли возможность учитывать не строки, а столбцы? например, переносить данные из каждого файла CSV в тринадцатые по счету столбцы.
Это можно поправить командной строкой Хотя по скрину не лечим, и что там нарушено - без понятия... Но командная строка из первого ответа точно ничего не сломает.
mazersw написал: чтобы после выполнения макроса слияния файл сразу сохранялся автоматом
для этого как минимум необходимо, чтобы макрос находился не в той же книге, что и итоговая.
Цитата
mazersw написал: А можно ли как-то пропустить первый два шага вопроса?
они и так там пропущены, это раз. Два - раз так много лишнего проще вообще другой код использовать: Как объединить несколько текстовых файлов в один? замените там расширение на .csv и все. Правда, если первые строки надо исключить - придется немного пошаманить с переменной sTxt(перебрать циклом с только нужной строки).
Дмитрий(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