Добрый день! Есть файл с позициями, первый столбец которого показывает к какому поставщику относится товар. Задача разбить все эти товары на отдельные файлы по названию поставщика, соответственно в каждом файле должны быть товары конкретного поставщика. Подскажи, как через VBA копировать/вставлять строки в нужный файл в зависимости от названия в ячейке.
Немножко "накалякал" сам, но что-то мне кажется не в том русле плыву, макрос тренировочный, до конца не работает.
Код
Public Sub group()
Dim i As Integer, a As Integer
Dim book As Workbook
Dim book_name As String
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Set book = Workbooks.Add
book_name = ThisWorkbook.Sheets(1).Cells(i, 1)
book.SaveAs Filename:=book_name
ThisWorkbook.Activate
Rows(1).Select
Selection.Copy
book.Activate
book.Sheets(1).Rows(1).Select
Sheets(1).Paste
For a = 2 To ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If ThisWorkbook.Sheets(1).Cells(a, 1).Value = book_name Then
ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Rows(a).Select
Selection.Copy
book.Activate
book.Sheets(1).Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
End If
Next a
Next i
End Sub
А вы понимаете в своем коде , что сделали? Поищите по форуму тут куча примеров с решением вашей задачи. Для начала нужно создать список поставщиков, с помощью либо коллекции либо словаря. Затем циклом по коллекции (словарю) - либо через фильтр копируя отфильтрованное вставлять н в новую книгу, либо по массиву сравнивая создавать под массивы и выкладывать на лист вновь созданной книги, которую сохраняете с вставленными данными и закрываете. Можно так же через SQL запрос, но думаю , что это не Ваш вариант, хотя на форуме, где то и такой есть.
Nordheim, спасибо за алгоритм, такого ответа я и ждал, макрос написал, все работает. Кому интересно -
Код
Public Sub group_2()
Dim MyCollection As New Collection
Dim i As Integer, a As Integer, k As Integer, l As Integer
Dim book As Workbook
Dim book_name As String
Application.ScreenUpdating = False
On Error Resume Next
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
MyCollection.Add Cells(i, 1).Value, Cells(i, 1).Value
Next i
Application.DisplayAlerts = 0
For i = 1 To MyCollection.Count
Workbooks.Add.SaveAs Filename:=ThisWorkbook.Path & "\" & MyCollection.Item(i)
For a = 1 To ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
ActiveWorkbook.Sheets(1).Cells(1, a) = ThisWorkbook.Sheets(1).Cells(1, a)
Next a
Next i
For i = 2 To ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
book_name = ThisWorkbook.Sheets(1).Cells(i, 1).Value
l = Workbooks(book_name & ".xlsx").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(book_name & ".xlsx").Sheets(1).Cells(l + 1, 1) = ThisWorkbook.Sheets(1).Cells(i, 1)
For k = 1 To ThisWorkbook.Sheets(1).Cells(i, Columns.Count).End(xlToLeft).Column
Workbooks(book_name & ".xlsx").Sheets(1).Cells(l + 1, k + 1) = ThisWorkbook.Sheets(1).Cells(i, k + 1)
Next k
Workbooks(book_name & ".xlsx").Sheets(1).Columns.EntireColumn.AutoFit
Next i
For i = Workbooks.Count To MyCollection.Count + 1 Step -1
Workbooks(i).Close True
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = 1
End Sub
Что работает это хорошо, но при циклах беря данные с листа вы теряете в скорости, если будут большие объемы, но иакрос на массивах отработает в разы быстрее, убедился не раз на собственном опыте.
"Все гениальное просто, а все простое гениально!!!"
По макросу: 1. Если нужна скорость, то подобные вещи
Код
Workbooks(book_name & ".xlsx").Sheets(1)
тоже стоит исключить. По возможности объявляйте дополнительную переменную листа, и ее используйте вместо полного названия, либо используйте хотя бы конструкцию with, что делает код более читабельным (имхо) и несколько ускоряет макрос. 2. Форматирование лучше вынести из цикла (autofit). Зачем каждый раз проделывать идентичную операцию, когда можно ее выполнить один раз за пределами циклов. 3. С циклами всегда работайте осторожно. Старайтесь убирать вложенность, где это только возможно. Если все таки вложенность нужна, старайтесь использовать конструкции vba: массивы, коллекции, словари и т.д. Они достаточно быстрые. 4. Ну и напоследок: если решили начать оптимизацию скорости через обновление экрана (screenupdating), то старайтесь
включать ручные вычисления (calculation);
использовать конструкции языка типа словари, коллекции, массивы и т.д.;
убирать любого рода выделения и активации (где это возможно) через методы select и activate;
уходить от новых переменных типа variant (для самодисциплины также используйте option explicit в самом начале модуля ВСЕГДА);
использовать двоеточие для объединения нескольких связанных строк в одну