Excel - поиск и отображение запроса

вопрос

Я не айтишник .. У меня есть простое требование, но я не знаю, как это сделать.

Требование

 Мои данные. Проект Sno Release Контактные лица 1 апреля SYL Сэм, Марк, Том 2 мая Ксим Том, Франк, Ким 3 июня TIG Ким, Дэвид, Сэм 

Мое требование - когда я ищу по проекту или по релизу, мне нужно получить все имена контактных лиц. Точно так же, если я ищу по имени контактного лица. Например, Сэм в приведенном выше примере. Excel должен показать мне все проекты, в которых участвовал Сэм, со всеми соответствующими данными, такими как Release и т. д. Это должно быть отображено на новом листе в Excel.

Можно ли это сделать в Excel или мне нужно попробовать что-то еще? Можете ли вы помочь мне в этом?

Решение

Предположения:

  • 1. Название листа, где данные «Лист1» (исправьте код, если это не так)
  • 2. Имя листа, в который нужно вставить результат поиска, - «Результат» (исправьте код, если его нет).
  • 3. Предыдущие результаты поиска должны быть отброшены
  • 4. Данные по 4 столбцам (как в примере)

ШАГИ:

  • 1. Прочитайте предположения
  • 2. Сделайте резервную копию
  • 3. Нажмите ALT + F11 одновременно, чтобы войти в среду VBE
  • 4. Нажмите «Вставить» и добавьте новый модуль.
  • 5. Вставьте код (после инструкции)
  • 6. Запустите код

Код:

 Sub SearchData () Dim lMaxRows As Long 'максимальное количество строк данных на основе ячеек, используемых в столбце A Dim lFilterRows As Long' последняя отфильтрованная строка Dim searchRel As Variant 'что следует искать для Release Info Dim searchProj As Variant' что такое для поиска информации о проекте Dim searchPpl As Variant 'то, что нужно искать Контактная информация Dim sDataSheet As String' имя таблицы данных Dim sResultSheet As String 'имя таблицы результатов sDataSheet = "Sheet1" "имя таблицы данных sResultSheet = "Result" 'имя листа результатов' с критериями поиска searchRel = InputBox ("Какой выпуск вы хотите найти. Чтобы пропустить, просто нажмите OK.") searchProj = InputBox ("Какой проект вы хотите найти. Пропустить, просто нажмите ОК. ") searchPpl = InputBox (" Какое контактное лицо вы хотите найти. Чтобы пропустить, просто нажмите ОК. ") 'удалить пробелы searchRel = Trim (searchRel) searchProj = Trim (searchProj) searchPpl = Trim (searchPpl ) ', если все три критерия поиска не заполнены, тогда ничего не делать If (Len (searchRel & searchProj & searchPpl) = 0) Затем Exit Sub On Ошибка Возобновить Следующее Application.DisplayAlerts = False 'удалить предыдущий лист результатов, если он существует Sheets (sResultSheet) .Delete Application.DisplayAlerts = True On Error GoTo 0' добавить лист результатов Sheets.Add ActiveSheet.Name = sResultSheet Sheets (sDataSheet) .Select Cells.Select 'удаление любого фильтра If ActiveSheet.AutoFilterMode Then On Error Возобновить Next ActiveSheet.ShowAllData При ошибке GoTo 0 End Если lMaxRows = Cells (Rows.Count, "A"). End. (xlUp) .Row If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter End If If (searchRel) "" Тогда поле Selection.AutoFilter: = 2, Criteria1: = "=" & searchRel, Оператор: = xlAnd, Criteria2: = " "End If If (searchProj)" "Then Поле Selection.AutoFilter: = 3, Criteria1: =" = "& searchProj, Оператор: = xlAnd, Criteria2: =" "End If If (searchPpl)" "Тогда поле Selection.AutoFilter : = 4, Criteria1: = "= *" & searchPpl & "*", Оператор: = xlAnd, Criteria2: = "" End If lFilterRows = Cells (Rows.Count, "A"). End (xlUp) .Row Range ( "А1: D" & lFilterRows). Копировать листы (sResultSheet). Выбрать диапазон («A1»). Выбрать ActiveSheet.Paste Sheets (sDataSheet) .Select Cells.Select 'удалить любой фильтр, если ActiveSheet.AutoFilterMode затем при ошибке возобновить следующий ActiveSheet.ShowAllData при ошибке Перейти 0 End If End Sub 

Заметка

Спасибо rizvisa1 за этот совет на форуме.

Предыдущая статья Следующая статья

Лучшие советы