Прошу помочь мне с реализацией следующей задачи. Я формирую таблицу/склад в которой отображается типы инструмента и материалов имеющихся на складе, кто заказывал, куда, состояние той или иной позиции. В конечном итоге все сводится к отчетности. Так вот задача состоит из нескольких сценариев, например 1-й) Сформировать отчет, что числиться за сотрудником Геннадий. Я выбираю в столбце "Числится за:" автофильтр "Геннадий" и нажимаю на кнопку например "Сформировать Отчет". В следствии на страницу "Отчет" копируются все строки вместе с главной при этом выставляется приоритетность столбцов, столбец "Числится за:" должен быть вторым после нумерации, третий должен быть "Название складской позиции" при этом синий и красный столбцы "Обслуживание и Закупка" должны исключаться. 2-й) принцип тот же но очтет формируеться на основании столбца "Числится на:". В итоге, отчет нужно будет формировать по столбцам "Категория, Подкатегория, Числится на:, Числится за:, Состояние" Думаю по всем остальным справится самому, если поможете хотя бы с первым сценарием.
Надеюсь написал не запутано. Прошу прощение заранее за свое делетанцтво, никогда не думал что столкнусь с макросами.
Доброго времени суток.
Прошу помочь мне с реализацией следующей задачи. Я формирую таблицу/склад в которой отображается типы инструмента и материалов имеющихся на складе, кто заказывал, куда, состояние той или иной позиции. В конечном итоге все сводится к отчетности. Так вот задача состоит из нескольких сценариев, например 1-й) Сформировать отчет, что числиться за сотрудником Геннадий. Я выбираю в столбце "Числится за:" автофильтр "Геннадий" и нажимаю на кнопку например "Сформировать Отчет". В следствии на страницу "Отчет" копируются все строки вместе с главной при этом выставляется приоритетность столбцов, столбец "Числится за:" должен быть вторым после нумерации, третий должен быть "Название складской позиции" при этом синий и красный столбцы "Обслуживание и Закупка" должны исключаться. 2-й) принцип тот же но очтет формируеться на основании столбца "Числится на:". В итоге, отчет нужно будет формировать по столбцам "Категория, Подкатегория, Числится на:, Числится за:, Состояние" Думаю по всем остальным справится самому, если поможете хотя бы с первым сценарием.
Надеюсь написал не запутано. Прошу прощение заранее за свое делетанцтво, никогда не думал что столкнусь с макросами.Ostin
Не люблю архивы =) Поэтому в качестве образца решения прикрепляю плод своего воображения с подробными комментариями.
На примере некоторой библиотеки разбирается поиск данных по критерию. Логику, разумеется, можете усложнить по вкусу.
[vba]
Код
Sub Report_Maker() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Data" Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Menu") 'Привяжем лист к переменной Z = 4 'Зададим первую строку, куда на листе "Menu" будем вносить данные
With ThisWorkbook.Worksheets("Data") 'Далее можно обращаться к листу "Data" с помощью точки
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим имя книги, которое указали, то... If .Cells(X, 3).Value = shtX.Cells(1, 1).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 5).Value 'Отметка о возврате книги shtX.Cells(Z, 2).Value = .Cells(X, 2).Value 'Дата выдачи книги shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Имя читателя 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
[/vba]
Ostin, здравствуйте.
Не люблю архивы =) Поэтому в качестве образца решения прикрепляю плод своего воображения с подробными комментариями.
На примере некоторой библиотеки разбирается поиск данных по критерию. Логику, разумеется, можете усложнить по вкусу.
[vba]
Код
Sub Report_Maker() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Data" Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Menu") 'Привяжем лист к переменной Z = 4 'Зададим первую строку, куда на листе "Menu" будем вносить данные
With ThisWorkbook.Worksheets("Data") 'Далее можно обращаться к листу "Data" с помощью точки
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим имя книги, которое указали, то... If .Cells(X, 3).Value = shtX.Cells(1, 1).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 5).Value 'Отметка о возврате книги shtX.Cells(Z, 2).Value = .Cells(X, 2).Value 'Дата выдачи книги shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Имя читателя 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
Огромное Вам спасибо, Ваша идея - не совсем то, что я себе представлял, но такой вид меня более чем устроит. Правда если Вас не затруднит, можно как то поправить код, что бы макрос осуществлял поиск на основании двух значений( я показал в примере)! Я, к сожалению полный чайник в ВБА. Мне бы хотелось что бы поиск осуществлялся на основании двух критериев, которые выбираются в зависимом выпадающем списке. Так как мне нужно осуществлять поиск и формирование отчета на основании нескольких столбцов. Списки я создавал методом Формулы -> Диспетчер имен. Заранее благодарю
Rioran, здравствуйте!
Огромное Вам спасибо, Ваша идея - не совсем то, что я себе представлял, но такой вид меня более чем устроит. Правда если Вас не затруднит, можно как то поправить код, что бы макрос осуществлял поиск на основании двух значений( я показал в примере)! Я, к сожалению полный чайник в ВБА. Мне бы хотелось что бы поиск осуществлялся на основании двух критериев, которые выбираются в зависимом выпадающем списке. Так как мне нужно осуществлять поиск и формирование отчета на основании нескольких столбцов. Списки я создавал методом Формулы -> Диспетчер имен. Заранее благодарюOstin
Ostin, помогать людям, которые пытаются разобраться сами - особое удовольствие. Если Вы можете с помощью моего примера решить свою задачу - то готов решительно оспорить любое Ваше сходство с предметом кухонной утвари
Для решения Вашего вопроса я добавил новую переменную, дабы указать программе нужный столбец. Плюс строка, в которой уточняется её значение. Плюс там, где раньше шёл поиск по конкретному номеру столбца - теперь ищем по столбцу, за который отвечает переменная. Как Вам такой вариант?
[vba]
Код
Sub Report_Maker_2() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Data" Dim Y As Byte 'Для уточнения столбца для поиска значения Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Menu") 'Привяжем лист к переменной Z = 4 'Зададим первую строку, куда на листе "Menu" будем вносить данные
'Далее можно обращаться к листу "Data" с помощью точки With ThisWorkbook.Worksheets("Data") 'Находим номер столбца, в котором ищем нужное значение Y = .Range("A1:E1").Find(shtX.Cells(1, 1).Value).Column
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим указанный параметр, то... If .Cells(X, Y).Value = shtX.Cells(1, 2).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 5).Value 'Отметка о возврате книги shtX.Cells(Z, 2).Value = .Cells(X, 2).Value 'Дата выдачи книги shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Имя читателя 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
[/vba]
Ostin, помогать людям, которые пытаются разобраться сами - особое удовольствие. Если Вы можете с помощью моего примера решить свою задачу - то готов решительно оспорить любое Ваше сходство с предметом кухонной утвари
Для решения Вашего вопроса я добавил новую переменную, дабы указать программе нужный столбец. Плюс строка, в которой уточняется её значение. Плюс там, где раньше шёл поиск по конкретному номеру столбца - теперь ищем по столбцу, за который отвечает переменная. Как Вам такой вариант?
[vba]
Код
Sub Report_Maker_2() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Data" Dim Y As Byte 'Для уточнения столбца для поиска значения Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Menu") 'Привяжем лист к переменной Z = 4 'Зададим первую строку, куда на листе "Menu" будем вносить данные
'Далее можно обращаться к листу "Data" с помощью точки With ThisWorkbook.Worksheets("Data") 'Находим номер столбца, в котором ищем нужное значение Y = .Range("A1:E1").Find(shtX.Cells(1, 1).Value).Column
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим указанный параметр, то... If .Cells(X, Y).Value = shtX.Cells(1, 2).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 5).Value 'Отметка о возврате книги shtX.Cells(Z, 2).Value = .Cells(X, 2).Value 'Дата выдачи книги shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Имя читателя 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
Rioran, спасибо за сравнение и за код. Тут уже было дело чести адаптировать ваш код под мои потребности, хоть и первый опыт работы с макросамы. В данном случае оказалось не тяжело. Есть у меня, конечно же, еще парочка заморочек, но это будут новые темы. [vba]
Код
Sub Report_Maker_2() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Склад" Dim Y As Byte 'Для уточнения столбца для поиска значения Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Отчет") 'Привяжем лист к переменной Z = 6 'Зададим первую строку, куда на листе "Menu" будем вносить данные
'Далее можно обращаться к листу "Склад" с помощью точки With ThisWorkbook.Worksheets("Склад") 'Находим номер столбца, в котором ищем нужное значение Y = .Range("A1:R1").Find(shtX.Cells(1, 4).Value).Column
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим указанный параметр, то... If .Cells(X, Y).Value = shtX.Cells(1, 2).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 2).Value 'Название_складской_позиции shtX.Cells(Z, 2).Value = .Cells(X, 3).Value 'инвен_ный_№ shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Ед. изм. shtX.Cells(Z, 4).Value = .Cells(X, 5).Value 'Кол. shtX.Cells(Z, 5).Value = .Cells(X, 8).Value 'Числится на: shtX.Cells(Z, 6).Value = .Cells(X, 9).Value 'Числится за: shtX.Cells(Z, 7).Value = .Cells(X, 17).Value 'Состояние 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
Sub Reset()
Dim X As Long: X = ThisWorkbook.Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row If X > 3 Then ThisWorkbook.Worksheets("Отчет").Range("A6:G" & X).Value = ""
End Sub
[/vba]
Rioran, спасибо за сравнение и за код. Тут уже было дело чести адаптировать ваш код под мои потребности, хоть и первый опыт работы с макросамы. В данном случае оказалось не тяжело. Есть у меня, конечно же, еще парочка заморочек, но это будут новые темы. [vba]
Код
Sub Report_Maker_2() Application.ScreenUpdating = False 'Отключение обновления экрана, для скорости программы
Dim shtX As Worksheet 'Для обращений к листу "Menu" Dim X As Long 'Для перебора строк листа "Склад" Dim Y As Byte 'Для уточнения столбца для поиска значения Dim Z As Long 'Для перебора строк листа "Menu"
Set shtX = ThisWorkbook.Worksheets("Отчет") 'Привяжем лист к переменной Z = 6 'Зададим первую строку, куда на листе "Menu" будем вносить данные
'Далее можно обращаться к листу "Склад" с помощью точки With ThisWorkbook.Worksheets("Склад") 'Находим номер столбца, в котором ищем нужное значение Y = .Range("A1:R1").Find(shtX.Cells(1, 4).Value).Column
'Перебираем строки листа "Data" кроме заголовков до последней найденной 1-го столбца For X = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 'Если в "Data" находим указанный параметр, то... If .Cells(X, Y).Value = shtX.Cells(1, 2).Value Then 'Заполняем строку Z найденными данными shtX.Cells(Z, 1).Value = .Cells(X, 2).Value 'Название_складской_позиции shtX.Cells(Z, 2).Value = .Cells(X, 3).Value 'инвен_ный_№ shtX.Cells(Z, 3).Value = .Cells(X, 4).Value 'Ед. изм. shtX.Cells(Z, 4).Value = .Cells(X, 5).Value 'Кол. shtX.Cells(Z, 5).Value = .Cells(X, 8).Value 'Числится на: shtX.Cells(Z, 6).Value = .Cells(X, 9).Value 'Числится за: shtX.Cells(Z, 7).Value = .Cells(X, 17).Value 'Состояние 'Увеличиваем значение строки, чтобы в следующий раз писать на новую. Z = Z + 1 'Закрываем блок "Если" End If 'Отработав одно значение Х переходим к следующему. Next X
End With 'Отключение автоматического обращения к листу shtX Application.ScreenUpdating = True 'Возвращаем обновление экрана. End Sub
Sub Reset()
Dim X As Long: X = ThisWorkbook.Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row If X > 3 Then ThisWorkbook.Worksheets("Отчет").Range("A6:G" & X).Value = ""
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
