Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос поиска слова в ячейке
 
#1
13.09.2021 16:58:49
Добрый день! Задача такова: имеется таблица размером (A1:A1000). В каждой ячейке множество разных слов. Нужно написать макрос, чтобы, ввел в ячейку C1 искомое слово, например, "желтый" и из 1000 строк, были бы видны лишь те строки в которых находится искомое слово - "желтый".
Также чтобы можно было применить второй уровень фильтрации, например, в D1 введу, "15", то должны остаться лишь те строки , в которых присутствуют слова "желтый" и "15".
Изменено: zz - 13.09.2021 16:59:19
 
 
 
#2
13.09.2021 17:01:39
И что уже пробовали сделать? Что именно не получается? И сколько таких уровней:
Цитата
zz написал:
Также чтобы можно было применить второй уровень фильтрации
записав макрорекордером код можно получить почти готовое решение. Вы это пробовали сделать?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
13.09.2021 17:12:11
Код
Sub Анархия15()
    Dim x As Integer
    With ActiveSheet
        x = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If x < 3 Then Exit Sub
        Dim crr As Variant
        If x = 3 Then
            ReDim crr(1 To 1, 1 To 1)
        Else
            crr = .Range(.Cells(1, 3), .Cells(1, x))
        End If
        
        Dim y As Long
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        If y = 1 Then Exit Sub
        Dim arr As Variant
        arr = .Range(.Cells(1, 1), .Cells(y, 1))
        
        Dim flag As Boolean
        .Cells.EntireRow.Hidden = False
        For y = 2 To UBound(arr, 1)
            flag = False
            For x = 1 To UBound(crr, 2)
                If InStr(arr(y, 1), crr(1, x)) > 0 Then
                    flag = True
                    Exit For
                End If
            Next
            If flag = False Then .Cells(y, 1).EntireRow.Hidden = True
        Next
    End With
End Sub
 
 
 
#4
13.09.2021 17:24:18
Цитата
Дмитрий(The_Prist) Щербаков написал:
И что уже пробовали сделать? Что именно не получается? И сколько таких уровней:
уровня 3. (если имеет значение, то ищу конкретные 27 слов).
данный макрос к сожалению ищет совпадение лишь из одного столбца. У меня диапазон таблицы А7:A1000 , а поиск нужно осуществлять в ячейках C1,D1,E1, (цвет, размер. вес товара).
Код
Private Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Range("A2:I5")) Is Nothing Then
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
    End If
End Sub
Изменено: zz - 13.09.2021 17:27:38
 
 
 
#5
13.09.2021 17:35:05
Код
Sub Анархия16()
    Dim x As Integer
    With ActiveSheet
        x = .Cells(1, .Columns.Count).End(xlToLeft).Column
        If x < 3 Then Exit Sub
        .Cells.EntireRow.Hidden = False
        
        Dim crr As Variant
        If x = 3 Then
            ReDim crr(1 To 1, 1 To 1)
            crr(1, 1) = .Cells(1, 3).Value
        Else
            crr = .Range(.Cells(1, 3), .Cells(1, x))
        End If
        
        Dim y As Long
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        If y = 1 Then Exit Sub
        Dim arr As Variant
        arr = .Range(.Cells(1, 1), .Cells(y, 1))
        
        Dim flag As Boolean
        For y = 2 To UBound(arr, 1)
            flag = True
            For x = 1 To UBound(crr, 2)
                If InStr(arr(y, 1), crr(1, x)) = 0 Then
                    flag = False
                    Exit For
                End If
            Next
            If flag = False Then .Cells(y, 1).EntireRow.Hidden = True
        Next
    End With
End Sub

'Это в модуль листа.
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Rows(1)) Is Nothing Then
        Анархия15
    End If
End Sub
 
 
 
#6
13.09.2021 19:08:54
Решил проблему, через мною же предложенный макрос, всех благодарю за содействие
Изменено: zz - 13.09.2021 19:19:14
 
 
 
Страницы: 1
Наверх