Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel - VBA

Узнай цену своей работы

Формулировка задачи:

Добрый день! Ситуация такая. В столбце А слова: нос кот мышь В столбце В фразы: длинный нос кот спит нос тихо мышь сопит два попугая Задача - чтобы макрос удалил из столбца В те ячейки, в которых

содержатся

слова из столбца А. Т.е должно остаться: два попугая. Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "нос" = "нос", но игнорирует "длинный нос". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст )) Ниже макрос:
Листинг программы
  1. Sub Udalenie_Strok_Po_Shablonu()
  2. Dim r As Long, FirstRow As Long, LastRow As Long
  3. Dim Region As Range, iRow As Range, Cell As Range
  4. Dim Shablon As String
  5. Shablon = "здесь вводится искомый текст"
  6. Set Region = ActiveSheet.UsedRange
  7. FirstRow = Region.Row
  8. LastRow = Region.Row - 1 + Region.Rows.Count
  9. For r = LastRow To FirstRow Step -1
  10. Set iRow = Region.Rows(r - FirstRow + 1)
  11. For Each Cell In iRow.Cells
  12. If Cell Like Shablon Then
  13. Rows(r).Delete
  14. End If
  15. Next Cell
  16. Next r
  17. End Sub
Признателен за ответы!
Немного неправильно написал. Вот так точнее: В столбце А слова: один два три В столбце В, С, D и так далее - фразы: сорок один пятьдесят один сорок два два пятьдесят три сорок три четыре сорок четыре пятьдесят и так далее. Задача - чтобы макрос удалил из столбцов В, С и далее те ячейки, в которых

содержатся

слова из столбца А. Т.е должно остаться: четыре сорок четыре пятьдесят Но тот макрос, который я нашел, во-первых, удаляет только полное совпадение: "три" = "три", но игнорирует "три сорок". А во-вторых, хочется загрузить в макрос весь столбец А, чтобы не вставлять в макрос по одному слову, а как это сделать в нем - я не знаю. Помогите, пжлст ))

Решение задачи: «Макрос на поиск содержимого из столбца А в остальных столбцах - MS Excel»

textual
Листинг программы
  1. Sub Vito()
  2. Dim x
  3.   With Range(Columns(2), Columns(Columns.Count))
  4.     For Each x In Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
  5.       .Replace "*" & Trim$(x) & "*", "", xlWhole
  6.     Next
  7.     .SpecialCells(xlCellTypeBlanks).Delete xlUp
  8.   End With
  9. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.643 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы