Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel - VBA
Формулировка задачи:
Добрый день!
Ситуация такая.
В столбце А слова:
нос
кот
мышь
В столбце В фразы:
длинный нос
кот спит
нос
тихо мышь сопит
два попугая
Задача - чтобы макрос удалил из столбца В те ячейки, в которых
Признателен за ответы!
содержатся
слова из столбца А. Т.е должно остаться: два попугая. Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "нос" = "нос", но игнорирует "длинный нос". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст )) Ниже макрос:
Листинг программы
- Sub Udalenie_Strok_Po_Shablonu()
- Dim r As Long, FirstRow As Long, LastRow As Long
- Dim Region As Range, iRow As Range, Cell As Range
- Dim Shablon As String
- Shablon = "здесь вводится искомый текст"
- Set Region = ActiveSheet.UsedRange
- FirstRow = Region.Row
- LastRow = Region.Row - 1 + Region.Rows.Count
- For r = LastRow To FirstRow Step -1
- Set iRow = Region.Rows(r - FirstRow + 1)
- For Each Cell In iRow.Cells
- If Cell Like Shablon Then
- Rows(r).Delete
- End If
- Next Cell
- Next r
- End Sub
Немного неправильно написал. Вот так точнее:
В столбце А слова:
один
два
три
В столбце В, С, D и так далее - фразы:
сорок один пятьдесят один
сорок два два пятьдесят
три сорок три
четыре сорок четыре пятьдесят и так далее.
Задача - чтобы макрос удалил из столбцов В, С и далее те ячейки, в которых
содержатся
слова из столбца А. Т.е должно остаться: четыре сорок четыре пятьдесят Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "три" = "три", но игнорирует "три сорок". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст ))Решение задачи: «Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel»
textual
Листинг программы
- Sub Vito()
- Dim x
- With Range(Columns(2), Columns(Columns.Count))
- For Each x In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
- .Replace "*" & Trim$(x) & "*", "", xlWhole
- Next
- .SpecialCells(xlCellTypeBlanks).Delete xlUp
- End With
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д