Доброго времени суток уважаемые форумчане!
Столкнулся с аналогичной задачей, что и (),
НО у меня рабочие таблицы больше (до столбца FK).
Пожалуйста если это не трудно, сделайте комментарии в коде (см. в конце поста, надеюсь автор не будет против), я хочу сам настроить макрос под себя, чтобы не наглеть и не просить решить задачу.
Мне необходимо регулярно сводить одинаковые листы разных книг в одну. Сейчас мучаюсь руками, но это постоянно добавляет дубли, потому как фильтр по возрастанию не всегда установлен и приходится при копипасте ручками чистить. Файлы неизбежно растут и количество добавляемых дублей тоже.
Суть макроса не просто собрать, а добавлять новые уникальные значения к уже имеющимся в сводной книге. Собирает данные из сетевых папок, названия книг исходников разные, названия листа одинаковые, формат таблицы на листе одинаковый. В принципе все как в коде описанном выше.
У меня есть поле которое может служить параметром поиска и добавления, это номер заявки (во всех книгах сейчас! это диапазон EB3:EB1002, но может поменяться).
Сразу возник вопрос, у меня часть значений поля номер заявки выглядит как #Н/Д, т.к. это расчетное значение и пока строка не заполнена, соответственно и считать нечего.
Вопрос: это значение будет являться параметром для сбора строк в сводную? Если да, то как можно потом эти строки удалить из собранной динамичной таблицы?
Копировать в сводную книгу нужно всю строку с найденным уникальным значением ячейки EB(x), если быть точнее это с A до EN(включительно), для инфо на EN таблица не заканчивается, остальная часть заполняется в сводной и обновляется в исходниках для информирования менеджеров.
Заранее признателен за помощь (комментирование кода или советы как это реализовать)!
Столкнулся с аналогичной задачей, что и (),
НО у меня рабочие таблицы больше (до столбца FK).
Пожалуйста если это не трудно, сделайте комментарии в коде (см. в конце поста, надеюсь автор не будет против), я хочу сам настроить макрос под себя, чтобы не наглеть и не просить решить задачу.
Мне необходимо регулярно сводить одинаковые листы разных книг в одну. Сейчас мучаюсь руками, но это постоянно добавляет дубли, потому как фильтр по возрастанию не всегда установлен и приходится при копипасте ручками чистить. Файлы неизбежно растут и количество добавляемых дублей тоже.
Суть макроса не просто собрать, а добавлять новые уникальные значения к уже имеющимся в сводной книге. Собирает данные из сетевых папок, названия книг исходников разные, названия листа одинаковые, формат таблицы на листе одинаковый. В принципе все как в коде описанном выше.
У меня есть поле которое может служить параметром поиска и добавления, это номер заявки (во всех книгах сейчас! это диапазон EB3:EB1002, но может поменяться).
Сразу возник вопрос, у меня часть значений поля номер заявки выглядит как #Н/Д, т.к. это расчетное значение и пока строка не заполнена, соответственно и считать нечего.
Вопрос: это значение будет являться параметром для сбора строк в сводную? Если да, то как можно потом эти строки удалить из собранной динамичной таблицы?
Копировать в сводную книгу нужно всю строку с найденным уникальным значением ячейки EB(x), если быть точнее это с A до EN(включительно), для инфо на EN таблица не заканчивается, остальная часть заполняется в сводной и обновляется в исходниках для информирования менеджеров.
Заранее признателен за помощь (комментирование кода или советы как это реализовать)!
| Код |
|---|
Option Explicit
'Kuzmich октябрь 2016 г
'http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=83725
Dim i As Integer
Dim iLastNew As Integer
Sub Кнопка14_Щелкнуть()
Dim FoundSupplier As Range
Dim FoundMagazin As Range
Dim iLastRow As Integer
Dim FAdr As String
Dim FAdrMagaz As String
Dim flag As Boolean
Application.ScreenUpdating = False
With Worksheets("Page1")
Set FoundSupplier = .Columns("L:M").Find("Поставщик", , xlValues, xlWhole)
If Not FoundSupplier Is Nothing Then
FAdr = FoundSupplier.Address
Do
iLastRow = .Cells(FoundSupplier.Row + 2, 12).End(xlDown).Row
For i = FoundSupplier.Row + 2 To iLastRow
Set FoundMagazin = Columns("E").Find(.Cells(i, 12), , xlValues, xlWhole)
If Not FoundMagazin Is Nothing Then
FAdrMagaz = FoundMagazin.Address
flag = False
Do
iLastNew = Range("A1").End(xlDown).Row + 1
If .Cells(i, 5) = Cells(FoundMagazin.Row, 2) And _
.Cells(i, 10) = Cells(FoundMagazin.Row, 3) And _
.Cells(i, 16) = Cells(FoundMagazin.Row, 7) Then
flag = True 'есть на листе NEWСверка такая накладная
End If
Set FoundMagazin = Columns("E").FindNext(FoundMagazin)
Loop While FoundMagazin.Address <> FAdrMagaz
If Not flag Then
Call iInsertRow
End If
Else 'новый поставщик, которого нет на листе NEWСверка
iLastNew = Range("A1").End(xlDown).Row + 1
Call iInsertRow
End If
Next
Set FoundSupplier = .Columns("L:M").Find("Поставщик", FoundSupplier)
Loop While FoundSupplier.Address <> FAdr
End If
End With
Application.ScreenUpdating = True
End Sub
Sub iInsertRow()
Rows(iLastNew).Insert
With Worksheets("Page1")
Cells(iLastNew, 1) = .Range("C" & i) 'тип
Cells(iLastNew, 2) = .Range("E" & i) 'номер
Cells(iLastNew, 3) = .Range("J" & i) 'дата
Cells(iLastNew, 4) = .Range("K" & i) 'валюта
Cells(iLastNew, 5) = .Range("L" & i) 'поставщик
Cells(iLastNew, 7) = .Range("P" & i) 'сумма б/н
Cells(iLastNew, 7).NumberFormat = "#,##0.00"
End With
End Sub |
