Добрый день, периодически требуется собирать данные из файлов excel и решил немного автоматизировать этот процесс, но т.к. нет достаточных знаний не всё получается Описание процесса:
в каталоге имеются файлы 01_**, 02_**, .... XX_*** (первые три символа в имени могут повторяться несколько раз, это файлы из одного источника)
в каждом файле 1 лист, на нём данные отформатированы как таблица
необходимо объединить эти таблицы в одну с каждого файла, у которого первые 3 символа в имени одинаковые (например со всех 01_***) и сохранить в файл (01_.xlsx)
Сейчас не совсем понятен этап объединения данных из файлов без объединения их в одну книгу
Подскажите как можно изменить макрос в файле test2.xlsm чтобы данные собирались уже в новый файл (например из файлов 01_** в 01_.xlsx без добавления в текущую книгу)
UPD смотрю в сторону OLEDB, но пока не понятно как выбирать данные из файлов с одинаковыми тремя первыми символами в имени, при указании листов в книге с объединенными файлами записи на новый лист (не файл) переносит:
Код
For i = 1 To Sheets.Count
If Sheets(i).Name Like "07_" & "*" & "(" & "*" Then
strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';")
strSQL = "SELECT * FROM [" & Sheets(i).Name & "$] union all SELECT * FROM [" & Left(Sheets(i).Name, 3) & "$]"
'MsgBox strSQL
With ThisWorkbook.Sheets("NEW7")
.UsedRange.Clear
With .QueryTables.Add(strConnection, .Range("A1"), strSQL)
.Refresh False
.Delete
End With
End With
Next
PowerBoy, спасибо, посмотрел - если объединять все файлы из каталога то подходит. но у меня немного другое - пары файлов 01_*** надо объединить в одну таблицу в файле например 01_new
возможно не все возможности проверил - в надстройке по вашей ссылке такое возможно?
этот закрывается через строку после End With и перед следующим if
я и не претендую на авторство - тут 2 или 3 примера вместе из выдачи google ("объединение книг excel " , "собрать таблицы" и т.п.) , возможно даже с этого форума есть что-то
Со сборкой листов в книгу всё понятно, вот как объединять данные с "парных" листов пока не совсем понятно. Сегодня попробовал PowerQuery - теоретически можно по имени файла фильтровать лист с обработанным каталогом копировать лист с последующим сохранением... надо будет попробовать такой вариант
код с IF
Скрытый текст
Код
If Sheets(i).Name Like "07_" & "*" & "(" & "*" Then
strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';")
strSQL = "SELECT * FROM [" & Left(Sheets(i).Name, 3) & "$] union all SELECT * FROM [" & Sheets(i).Name & "$]"
'MsgBox strSQL
With ThisWorkbook.Sheets("NEW7")
.UsedRange.Clear
With .QueryTables.Add(strConnection, .Range("A1"), strSQL)
.Refresh False
.Delete
End With
End With
End If
If Sheets(i).Name Like "08_" & "*" & "(" & "*" Then
strConnection = IIf(Val(Application.Version) < 12, "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=3';", "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=3';")
strSQL = "SELECT * FROM [" & Left(Sheets(i).Name, 3) & "$] union all SELECT * FROM [" & Sheets(i).Name & "$]"
With ThisWorkbook.Sheets("NEW8")
.UsedRange.Clear
With .QueryTables.Add(strConnection, .Range("A1"), strSQL)
.Refresh False
.Delete
End With
End With
End If