Добрый день, Нужна ваша помощь для реализации, думаю не сложной, задачи. Стандартными средствами Excel задача не решается. Нужно сделать макрос. К сожалению моих знаний не хватает.
Во вложенном файле шаблон, который содержат материал для реализации задачи. Есть рабочие листы Пост1, Пост2, Пост3, Пост4 которые постоянно наполняются информацией. На основании этой информации нужно сделать отчёты: Бюджет (отдельный лист) и Груз в пути (отдельный лист).
1) Бюджет формируется по следующим критериям: Указываем диапазон даты пример: от 01,11,14 и до 30,11,14, после нажатия кнопки "загрузить" на лист Бюджет копируются строки (если есть возможность определенные ячейки в этих строках) Дата оплаты которых попадает в этот диапазон. Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно вставляются на Лист Бюджет.
2) Груз в пути формируется по следующему условию: Указываем дату, на которую нужно определить груз в пути после нажатия кнопки "загрузить" применяем условие отбора строк. Все строки, которые: Дата загрузки < ("Дата")< Дата прихода пример: 15.10.2014<("01.11.2014")<15.11.14. Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно копируются строки (если есть возможность определенные ячейки в этих строках) на Лист Груз в пути.
Заранее благодарю за любую помощь!
Добрый день, Нужна ваша помощь для реализации, думаю не сложной, задачи. Стандартными средствами Excel задача не решается. Нужно сделать макрос. К сожалению моих знаний не хватает.
Во вложенном файле шаблон, который содержат материал для реализации задачи. Есть рабочие листы Пост1, Пост2, Пост3, Пост4 которые постоянно наполняются информацией. На основании этой информации нужно сделать отчёты: Бюджет (отдельный лист) и Груз в пути (отдельный лист).
1) Бюджет формируется по следующим критериям: Указываем диапазон даты пример: от 01,11,14 и до 30,11,14, после нажатия кнопки "загрузить" на лист Бюджет копируются строки (если есть возможность определенные ячейки в этих строках) Дата оплаты которых попадает в этот диапазон. Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно вставляются на Лист Бюджет.
2) Груз в пути формируется по следующему условию: Указываем дату, на которую нужно определить груз в пути после нажатия кнопки "загрузить" применяем условие отбора строк. Все строки, которые: Дата загрузки < ("Дата")< Дата прихода пример: 15.10.2014<("01.11.2014")<15.11.14. Из каждого листа Пост1, Пост2, Пост3, Пост4 последовательно копируются строки (если есть возможность определенные ячейки в этих строках) на Лист Груз в пути.
Предлагаю программу, протестировать можно во вложении. Ваш изначальный файл пришлось несколько почистить, дабы уменьшить его вес до минимума.
Коды для обоих кнопок похожи, ниже образец кода для кнопки "Бюджета".
Программа очищает ранее выведенную на экран информацию, перебирает все листы книги, в которой установлена, и если имя листа начинается со слова "Пост" - начинает перебирать строки таблицы.
Как Вам такой вариант?
[vba]
Код
Sub Rio_Consolidation_Budget()
'Author: Roman "Rioran" Voronov 'Date: the 29-th of October, 2014 'Feedback: voronov_rv@mail.ru
For Each ShtX In ThisWorkbook.Worksheets With ShtX If Left(.Name, 4) = "Пост" Then C = .Cells(.Rows.Count, 1).End(xlUp).Row If C > 2 Then For A = 2 To C DateX = .Cells(A, 9).Value If DateX >= DateA And DateX <= DateB Then B = B + 1 ShtA.Cells(B, 1).Value = B - 3 ShtA.Cells(B, 2).Resize(1, 3).Value = .Range(.Cells(A, 2), .Cells(A, 4)).Value ShtA.Cells(B, 5).Resize(1, 2).Value = .Range(.Cells(A, 6), .Cells(A, 7)).Value End If Next A End If End If End With Next ShtX
Set ShtA = Nothing Application.ScreenUpdating = True
End Sub
[/vba]
Mutarix, здравствуйте.
Предлагаю программу, протестировать можно во вложении. Ваш изначальный файл пришлось несколько почистить, дабы уменьшить его вес до минимума.
Коды для обоих кнопок похожи, ниже образец кода для кнопки "Бюджета".
Программа очищает ранее выведенную на экран информацию, перебирает все листы книги, в которой установлена, и если имя листа начинается со слова "Пост" - начинает перебирать строки таблицы.
Как Вам такой вариант?
[vba]
Код
Sub Rio_Consolidation_Budget()
'Author: Roman "Rioran" Voronov 'Date: the 29-th of October, 2014 'Feedback: voronov_rv@mail.ru
For Each ShtX In ThisWorkbook.Worksheets With ShtX If Left(.Name, 4) = "Пост" Then C = .Cells(.Rows.Count, 1).End(xlUp).Row If C > 2 Then For A = 2 To C DateX = .Cells(A, 9).Value If DateX >= DateA And DateX <= DateB Then B = B + 1 ShtA.Cells(B, 1).Value = B - 3 ShtA.Cells(B, 2).Resize(1, 3).Value = .Range(.Cells(A, 2), .Cells(A, 4)).Value ShtA.Cells(B, 5).Resize(1, 2).Value = .Range(.Cells(A, 6), .Cells(A, 7)).Value End If Next A End If End If End With Next ShtX
Set ShtA = Nothing Application.ScreenUpdating = True
Rioran, Отлично всё работает. Только одна деталь. Название листа Пост1 ... n это название поставщика. Каждый раз кода я буду добавлять новый лист (поставщика) я хотелбы в ручную добавлять в код этот лист. If Left(.Name, 4) = "Пост" and "Пост2" ... and ... "Пост n" Then
Rioran, Отлично всё работает. Только одна деталь. Название листа Пост1 ... n это название поставщика. Каждый раз кода я буду добавлять новый лист (поставщика) я хотелбы в ручную добавлять в код этот лист. If Left(.Name, 4) = "Пост" and "Пост2" ... and ... "Пост n" ThenMutarix
Sub Загрузить() Dim dn As Date, dk As Date, Ls&, s&, i& Application.ScreenUpdating = False dn = Range("J2") dk = Range("L2") For Ls = 1 To 4 s = Sheets("Бюджет").Range("A" & Rows.Count).End(xlUp).Row + 1 Post = "Пост" & Ls Sheets(Post).Select For i = 2 To Range("I" & Rows.Count).End(xlUp).Row If Cells(i, 9) >= dn And Cells(i, 9) <= dk Then With Sheets("Бюджет") .Cells(s, 1) = Val(.Cells(s - 1, 1)) + 1 .Cells(s, 2) = Cells(i, 2) .Cells(s, 3) = Cells(i, 3) .Cells(s, 4) = Cells(i, 4) .Cells(s, 5) = Cells(i, 6) .Cells(s, 6) = Cells(i, 7) s = s + 1 End With End If Next Next Sheets("Бюджет").Select Application.ScreenUpdating = True End Sub
[/vba]
Вариант
[vba]
Код
Sub Загрузить() Dim dn As Date, dk As Date, Ls&, s&, i& Application.ScreenUpdating = False dn = Range("J2") dk = Range("L2") For Ls = 1 To 4 s = Sheets("Бюджет").Range("A" & Rows.Count).End(xlUp).Row + 1 Post = "Пост" & Ls Sheets(Post).Select For i = 2 To Range("I" & Rows.Count).End(xlUp).Row If Cells(i, 9) >= dn And Cells(i, 9) <= dk Then With Sheets("Бюджет") .Cells(s, 1) = Val(.Cells(s - 1, 1)) + 1 .Cells(s, 2) = Cells(i, 2) .Cells(s, 3) = Cells(i, 3) .Cells(s, 4) = Cells(i, 4) .Cells(s, 5) = Cells(i, 6) .Cells(s, 6) = Cells(i, 7) s = s + 1 End With End If Next Next Sheets("Бюджет").Select Application.ScreenUpdating = True End Sub
Wasilic, Спасибо Работает нормально. Но есть несколько замечаний : не обнуляет данные перед очередным выполнение макроса. Нет возможности определять каждый лист отдельно.
Wasilic, Спасибо Работает нормально. Но есть несколько замечаний : не обнуляет данные перед очередным выполнение макроса. Нет возможности определять каждый лист отдельно.Mutarix
не обнуляет данные перед очередным выполнение макроса.
Так, в задаче такого не было. Да, я и не подумал, что для Вас это проблема. Просто, в начале процедуры вставить строку кода очистки диапазона? например до 1000 строк: [vba]
Честно говоря, я не понял что надо то? Имена листов, если они все "Пост" с нарастающим номером, как в примере - Пост1, Пост2 ... Пост4, и дальше будут Пост5, Пост6 и т. д. , то в цикле - [vba]
Код
For Ls = 1 To 4
[/vba]то есть, с первого по четвертый, надо просто установить "по какой" - столько, сколько их будет. Например [vba]
Код
For Ls = 1 To 6
[/vba]если их будет 6. Если же имена будут совершенно разные, то естно, нужен вариант перебора имен за исключением не нужных, как у Rioranа. А вообще то, вариантов много. Можно на листе "Бюджет" создать список имен листов в любом желаемом порядке и считывать их макросом. Можно ... Можно ...
не обнуляет данные перед очередным выполнение макроса.
Так, в задаче такого не было. Да, я и не подумал, что для Вас это проблема. Просто, в начале процедуры вставить строку кода очистки диапазона? например до 1000 строк: [vba]
Честно говоря, я не понял что надо то? Имена листов, если они все "Пост" с нарастающим номером, как в примере - Пост1, Пост2 ... Пост4, и дальше будут Пост5, Пост6 и т. д. , то в цикле - [vba]
Код
For Ls = 1 To 4
[/vba]то есть, с первого по четвертый, надо просто установить "по какой" - столько, сколько их будет. Например [vba]
Код
For Ls = 1 To 6
[/vba]если их будет 6. Если же имена будут совершенно разные, то естно, нужен вариант перебора имен за исключением не нужных, как у Rioranа. А вообще то, вариантов много. Можно на листе "Бюджет" создать список имен листов в любом желаемом порядке и считывать их макросом. Можно ... Можно ... Wasilich
Сообщение отредактировал Wasilic - Среда, 29.10.2014, 21:18
После адаптации предложенных вариантов к рабочей среде, было выявлены проблемы работы программы. Цикл поиска прерывался, если в ячейке попадалось значение: "#Н/Д" и #ЗНАЧ! Программа была доработана (выделено жирным):
For Each ShtX In ThisWorkbook.Worksheets With ShtX If .Name <> "Груз в пути" And .Name <> "Бюджет" Then C = .Cells(.Rows.Count, 1).End(xlUp).Row If C > 6 Then For A = 6 To C [b] If IsError(.Cells(A, 31).Value) Then[/b] [b]Else[/b] DateX = .Cells(A, 31).Value If DateX >= DateA And DateX <= DateB Then B = B + 1 ShtA.Cells(B, 1).Value = B - 3 ShtA.Cells(B, 2).Resize(1, 2).Value = .Range(.Cells(A, 2), .Cells(A, 3)).Value ShtA.Cells(B, 4).Resize(1, 1).Value = .Range(.Cells(A, 16), .Cells(A, 16)).Value * 1000 ShtA.Cells(B, 5).Resize(1, 2).Value = .Range(.Cells(A, 29), .Cells(A, 30)).Value ShtA.Cells(B, 7).Resize(1, 1).Value = .Range(.Cells(A, 31), .Cells(A, 31)).Value End If [b]End If[/b] Next A End If End If End With Next ShtX
Set ShtA = Nothing Application.ScreenUpdating = True
End Sub
[/vba]
Решение найдено!!!
После адаптации предложенных вариантов к рабочей среде, было выявлены проблемы работы программы. Цикл поиска прерывался, если в ячейке попадалось значение: "#Н/Д" и #ЗНАЧ! Программа была доработана (выделено жирным):
For Each ShtX In ThisWorkbook.Worksheets With ShtX If .Name <> "Груз в пути" And .Name <> "Бюджет" Then C = .Cells(.Rows.Count, 1).End(xlUp).Row If C > 6 Then For A = 6 To C [b] If IsError(.Cells(A, 31).Value) Then[/b] [b]Else[/b] DateX = .Cells(A, 31).Value If DateX >= DateA And DateX <= DateB Then B = B + 1 ShtA.Cells(B, 1).Value = B - 3 ShtA.Cells(B, 2).Resize(1, 2).Value = .Range(.Cells(A, 2), .Cells(A, 3)).Value ShtA.Cells(B, 4).Resize(1, 1).Value = .Range(.Cells(A, 16), .Cells(A, 16)).Value * 1000 ShtA.Cells(B, 5).Resize(1, 2).Value = .Range(.Cells(A, 29), .Cells(A, 30)).Value ShtA.Cells(B, 7).Resize(1, 1).Value = .Range(.Cells(A, 31), .Cells(A, 31)).Value End If [b]End If[/b] Next A End If End If End With Next ShtX
Set ShtA = Nothing Application.ScreenUpdating = True
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
