Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сохранение в отдельные файлы
 
Привет всем! Посоветовали ваш форум как очень отзывчивый и добрый.
У меня есть задача создать макрос. Макрос должен уметь фильтровать данные в одном столбце и сохранять по этой выборке в отдельные файлы
Приложил файл, там есть столбец "Продукт", в нем содержатся продукты "Сыр Огурец Шоколад" и тд, по исполнению Макроса в папке с файлом должны оказаться Файлы с именами "Огурец" "Сыр" "Томат" и тд, а так же кто купил по какой цене и какой уникальный номер этой покупки, если честно я в ступоре, помогите умницы и умники =D
Изменено: pympyy - 11 Фев 2018 13:13:52
 
pympyy, Действительно, помогающий тут и отзывчивые и добрый и по мнению модераторов, даже слишком и уменя есть сомнения что название темы соответстветует содержанию запроса.
Вы не рассматриваете что можно сделать набор файлов со сводной ссылающейся на приложенный файл, фильтр по продукту даст результат и обновление автоматическое?
.  
По вопросам из тем форума, личку не читаю.
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

Здравствуйте, в какую сторону копать? Создать файлы с нужными названиями и потом указать что по названиям применять фильтр?
Подойдет любое решение вопроса лишь был искомый результат
 
Некогда доделывать, но вот пока схематично, если кому интересны словарь с коллекциями:
Код
Option Explicit

Sub tt()
    Dim d As Object, a, i&, t$, el, col

    a = ActiveSheet.UsedRange.Columns(2).Value
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        t = a(i, 1)
        If Not d.exists(t) Then d.Add t, New Collection
        d.Item(t).Add i
    Next
    For Each el In d.keys
        Debug.Print "Открываем файл для " & el
        Debug.Print "копируем шапку"
        For Each col In d.Item(el)
            Debug.Print "копируем строки " & col
        Next
        Debug.Print "Сохраняем файл " & el
    Next

End Sub
 
Или набор файлов сосводной например. Подправить один раз источник на ту таблицу, что у вас есть и размножайте.
Изменено: БМВ - 11 Фев 2018 14:10:37
По вопросам из тем форума, личку не читаю.
 
Цитата
в какую сторону копать?
Код
Sub RaznestiDannye()
Dim i As Long
Dim n As Long
Dim Criterij As String
Dim iName As String
Dim WCur As Worksheet
Dim WbN As Workbook
Dim AutoFilter As AutoFilter
Application.ScreenUpdating = False
   Set WCur = ThisWorkbook.Worksheets("Лист1")
'отбор уникальных значений столбца B в столбец H
    Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy _
                                  , CopyToRange:=Range("H1"), Unique:=True
'количество уникальных значений продуктов
    n = Cells(Rows.Count, 8).End(xlUp).Row
    For i = 2 To n          'цикл по уникальным значениям
        Criterij = Cells(i, 8)
        iName = Criterij    'имя новой книги
    'создаем новую книгу с одним листом
      Set WbN = Workbooks.Add(xlWBATWorksheet)
    'ставим автофильтр по столбцу B
          WCur.Range("A1").CurrentRegion.AutoFilter 2, Criterij
    'копируем видимые строки в новую книгу
        WCur.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Лист1").Range("A1")
        WCur.AutoFilter.Range.AutoFilter
        
        WbN.Sheets("Лист1").Columns("A:D").AutoFit
        WbN.Sheets("Лист1").Columns("H").Delete
        WbN.SaveAs ThisWorkbook.Path & "\" & iName & ".xls"
        WbN.Close SaveChanges:=True
    Next
Application.ScreenUpdating = True
End Sub
 
Kuzmich, Здравствуйте! Отлично работает на примере, но когда переношу в свой файл, меняю буквы на нужные, вываливается ошибка 400, вот просто 400 и все, решения в интернете не нашел =(
 
Kuzmich, Если вам не сложно дайте пожалуйста комментарии к коду где что применяется, непонятно откуда взялась цифра 2 в строке 12 "(Rows.Count, 2)"
ну и в строке 17 что за 8 такая "Criterij = Cells(i, 8)"
Уверен что я делаю ошибку в них, потому что внимательно изучил где что нужно изменить
 
Цитата
в строке 12 "(Rows.Count, 2)"
2 - указывает на столбец В
Цитата
в строке 17 что за 8 такая "Criterij = Cells(i,8")
8 - указывает на столбец Н
 
Kuzmich,а скажите пожалуйста есть ли у этого кода какие-нибудь ограничения? к примеру пустые строки или обьединенные ячейки? все еще долбаюсь с этим кодом, заработало вроде но не на моем нужном документе =(
 
Цитата
pympyy написал:
есть ли у этого кода какие-нибудь ограничения? к примеру пустые строки или обьединенные ячейки?
А самостоятельно проверить нет возможности?
Страницы: 1
Читают тему (гостей: 1)
Наверх