Задача такая: если в ячейку вводится название мероприятия, нужно выполнить поиск по всем листам и, если найдётся совпадение названия мероприятия, отфильтровать лист с совпадением без пустых ячеек.
В прикреплённом файле пример: я ввожу на первом листе "мероприятие 1". Что нужно сделать, чтобы макрос нашёл "мероприятие 1" на другом листе и оставил в этом столбце только заполненные ячейки (образно говоря, оставил только фио тех, кто участвовал в мероприятии)?
Заранее спасибо, если кто-то хотя бы наведёт на мысль... У меня получался максимум автофильтр по уже известному столбцу (если, например, я знаю, что название мероприятия стоит в определённом столбце на определённом листе).
Пишите макрос на изменение содержимого ячейки С1 на первом листе далее поиск по всем листам в строке 1 нужного мероприятия перенос содержимого столбца на первый лист
Текст в ячейке Лист1!C1 будет меняться. Если там "мероприятие 1", макрос пробегается по всем листам и оставляет активным тот, на котором есть столбец "мероприятие 1". А затем фильтр на этот столбец "мероприятие 1" (я не знаю, каким по счету и на каком листе он будет) - оставить заполненные ячейки.
я не знаю, каким по счету и на каком листе он будет
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then
Application.EnableEvents = False
Dim FoundCell As Range
Dim Sht As Worksheet
Dim iLastRow As Long
For Each Sht In Worksheets
If Sht.Name <> "Лист1" Then
With Sht
Set FoundCell = .Rows(1).Find(Target, , xlValues, xlWhole)
If Not FoundCell Is Nothing Then
'FoundCell.Column - столбец в котором нашли мероприятие
iLastRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row
.Activate
'ставите фильтр
Application.EnableEvents = True
Exit Sub
End If
End With
End If
Next
End If
Application.EnableEvents = True
End Sub
Когда я меняю текст в ячейке D1 листа "Список мероприятий", ничего не происходит. Значит, макрос не работает? Не в красных ли строках ошибка? Там я пыталась записать, что нужно отфильтровать данные в столбце с совпадающим названием по признаку "исключить пустые".
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
Dim FoundCell As Range
Dim Sht As Worksheet
Dim iLastRow As Long
For Each Sht In Worksheets
If Sht.Name <> "Ñïèñîê ìåðîïðèÿòèé" Then
With Sht
Set FoundCell = .Rows(1).Find(Target, , xlValues, xlWhole)
If Not FoundCell Is Nothing Then
'FoundCell.Column - ??????? ? ??????? ????? ???????????
iLastRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row
.Activate
ActiveSheet.ShowAllData
Selection.AutoFilter ' проблема здесь
ActiveSheet.Range("$A$1:$Z$200").AutoFilter Field:=FoundCell.Column, Criteria1:="<>"
Application.EnableEvents = True
Exit Sub
End If
End With
End If
Next
End If
Application.EnableEvents = True
End Sub
В моём файле, в котором 75 листов с разными мероприятиями, лист с критериями называется "Список мероприятий", ячейка - D1. Для фильтра я записывала макрос через Excel: щёлкала на лист, в котором нашлось мероприятие, щёлкала на столбец с названием этого мероприятия и выбирала "Фильтр - кроме пустых". Но сейчас всё равно ничего не получается.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
Dim FoundCell As Range
Dim Sht As Worksheet
Dim iLastRow As Long
For Each Sht In Worksheets
If Sht.Name <> "Список мероприятий" Then
With Sht
Set FoundCell = .Rows(1).Find(Target, , xlValues, xlWhole)
If Not FoundCell Is Nothing Then
'FoundCell.Column - столбец в котором нашли мероприятие
iLastRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row
.Activate
Sheets("Стендовая стр").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$Z$200").AutoFilter Field:=FoundCell.Column, Criteria1:="<>"
Application.EnableEvents = True
Exit Sub
End If
End With
End If
Next
End If
Application.EnableEvents = True
End Sub
В моём файле, в котором 75 листов с разными мероприятиями
Все листы для примера приводить не надо, достаточно 2-3 В макросе активируется лист, в котором нашли мероприятие из D1. А вы выделяете лист Sheets("Стендовая стр").Select А надо выделять диапазон на активном листе, чтобы установить фильтр
Но я же не знаю, какой именно будет диапазон... Вот, например, в D1 написано "Гран-При Кипр...". Такое же мероприятие есть на листе "Стендовая стр". Мне нужно, чтобы, когда я ввожу в D1 "Списка мероприятий" "Гран-При Кипр", осуществлялся переход на лист "Стендовая стрельба" и ставился фильтр на "Гран-При Кипр" - только заполненные.
Код
.Activate ' активирую список
ActiveSheet.Range("$A$1:$Z$200").AutoFilter Field:=FoundCell.Column, Criteria1:="<>" ' если макрос нашел активный лист, выделяю на нем диапазон, в который точно входит мероприятие, и ставлю фильтр по FoundCell - непустая
Application.EnableEvents = True
Когда я меняю текст в ячейке D1 листа "Список мероприятий", ничего не происходит
Потому что макрос должен быть в модуле листа , а не в стандартном модуле. И еще у вас при переходе на лист "Стендовая стрельба" возникает какой-то круг и Excel виснет
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
Dim FoundCell As Range
Dim Sht As Worksheet
Dim iLastRow As Long
For Each Sht In Worksheets
If Sht.Name <> "Список мероприятий" Then
With Sht
Set FoundCell = .Rows(1).Find(Target, , xlValues, xlWhole)
If Not FoundCell Is Nothing Then
iLastRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row
.Activate
ActiveSheet.Range("A1:M78").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$78").AutoFilter Field:=FoundCell.Column, Criteria1:="<>"
Exit Sub
End If
End With
End If
Next
End If
Application.EnableEvents = True
End Sub
C первого раза всё сработало, а потом перестало... В общем, с переменным успехом. В любом случае ОГРОМНОЕ Вам спасибо, это был архиважный вопрос, который с высокой долей вероятности удалось решить!!!
Возможно, как и раньше я вам писал, что ничего не выделено. В примере из сообщения #20, по моему, не выло никакого выделения, а брался диапазон для автофильтра