Поиск ячейки и замена значения в строке листа VBA EXCEL

[khall]

Помогите, пожалуйста, с задачкой.
Как найти ячейку со значением, например, город, и очистить эту ячейку, а также зависимые с ней ячейки, расположенные на той же строке, что и найденная ячейка в диапазоне G8:G43 и E8:E43?

Этот код очищает все найденные ячейки со значением город, но не очищает те ячейки, которые находятся в той строке, что и ячейка со значением город.
Sub Поиск()

Dim c As Range
For Each c In [I8:I43]
If c.Value Like "город" Then
c.Value = ""
End If
Next
End Sub

Может быть так или есть код покрасивее? При этом остается проблема: если курсор не находится в ячейке диапазона I8:J20, появляется сообщение об ошибке. Ошибка появляется и тогда, когда в ячейках больше нет данных в диапазоне I8:J20. Как это все исправить?

Public Sub Поиск2()

Dim rng As Range

Set rng = Range("I8:J20").Find(What:="город", After:=ActiveCell, LookIn:=xlValues, _
MatchCase:=True)
Range("I8:J20").FindNext(After:=ActiveCell).Activate

If Not (rng Is Nothing) Then
Cells(ActiveCell.Row, ActiveCell.Column - 1).Select
ActiveCell = ""
Cells(ActiveCell.Row, ActiveCell.Column - 1).Select
ActiveCell = ""
Cells(ActiveCell.Row, ActiveCell.Column + 4).Select
ActiveCell = ""
Else
MsgBox "Не найдено значение"
End If

End Sub

Ниже все в одном файле

[GSerg]

Код: Выделить всё

Sub sdfsdf()
  Dim f As Excel.Range, w As Excel.Range
 
  Set w = Range("I8:I43")
  Set f = w.Find("город", , xlValues, xlWhole)
 
  Do Until f Is Nothing
    Range(f.Offset(0, -4), f).Value = Empty
    Set f = w.FindNext
  Loop
End Sub

[khall]

Код работает просто СУППЕР! Я его поместил в стандартный модуль Module1 с названием процедуры Поиск. К нему обращаются процедуры рабочих листов при наступлении события Worksheet_Change любого активного рабочего листа через Call Поиск. Теперь при наступлении изменения в ячейках D62 или D63, а соответственно и D65, автоматически удаляются названия "Телефон" и "город", а также сумма в грн. Это приводит к появлению только одной записи. Это мне и нужно!

Вот код рабочего листа Лист1. Такой же код присутствует и в других листах: Лист2...

В будущем, пожалуйста, проявляйте уважение к читающим и пользуйтесь форматированием кода.

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Range)

Dim тф As Range, i As String
Set тф = Range("D62:D65")

    If Not (Application.Intersect(Target, тф) Is Nothing) Then
        Call Поиск
       
        i = 8
        While Sheets("Лист1").Range("E" + LTrim$(Str$(i))) <> ""
        i = i + 1
        Wend
        Sheets("Лист1").Range("E" + LTrim$(Str$(i))) = Range("D65").Value
        Sheets("Лист1").Range("G" + LTrim$(Str$(i))) = "Телефон"
        Sheets("Лист1").Range("I" + LTrim$(Str$(i))) = "город"
    End If

End Sub

Стандартный модуль

Код: Выделить всё

Public Sub Поиск()

  Dim f As Excel.Range, w As Excel.Range
 
  Set w = Range("I8:J20")
  Set f = w.Find("город", , xlValues, xlWhole)

    Do Until f Is Nothing
      Range(f.Offset(0, -4), f).Value = Empty
      Set f = w.FindNext
    Loop
End Sub

Но я обнаружил особенность, которую теперь нужно устранить.
Иногда может получиться, что или ячейка D62 или D63 могут стать пустыми, что сделает пустой и ячейку D65. В этом случае значение ячейки, содержащей сумму расхода в грн. "Телефон" и "город", очищается, но остаются названия "Телефон" и "город" в ячейках столбцов G и I.

ВОПРОС: Как сделать, чтобы при удалении значения из ячейки с суммой в грн. удалялись и теперь ненужные записи "Телефон" и "город", которые были связаны с удаленной записью суммы в грн.

Как усовершенствовать код?

[GSerg]

Не улавливаю логику процесса и связи записей.

[khall]

Извини, пожалуйста, не знаю, как сделать, чтобы код удобно читался. Что нужно сделать?
[/b]

[GSerg]

Нужно нажать Ответ и там кнопку VB.

[khall]

Спасибо тебе за терпение! Я только учусь!
Кое-что будет экспериментом.
Во всяком случае, спасибо за твой код, который работает исключительно.

Код: Выделить всё

Public Sub Поиск()

  Dim f As Excel.Range, w As Excel.Range
 
  Set w = Range("I8:J20")
  Set f = w.Find("город", , xlValues, xlWhole)

    Do Until f Is Nothing
      Range(f.Offset(0, -4), f).Value = Empty
      Set f = w.FindNext
    Loop
End Sub

Получилось!!!

[khall]

Я уже подготовил для тебя вопрос. Чуть позже отправлю. Хорошо?

[GSerg]

Специфика общения на форуме несколько иная.
Во-первых, не мне, а нам, и во-вторых, спрашивать разрешения на вопрос не надо.

[khall]

Понял

[Igor[hw]]

Привет всем.

А как можно сделать поиск двух разных слов например "город" и "улица" ?

[alibek]

Одновременно? Да никак, пожалуй.
Но ты можешь перебирать ячейки, или искать вначале одно слово, затем другое.

[Igor[hw]]

Да одну и ту де процедуру пришлось запускать с разным параметром поиска. Ну а так все работает. Спасибо за ответ !

[Vladimir87]

Здравствуйте! У меня такая проблема. Есть 4 столбца НАИМЕНОВАНИЯ ЦЕНА НАИМЕНОВАНИЯ1 ЦЕНА1 вопрос вот в чём есть ли такая возможность сопоставить значения столбца НАИМЕНОВАНИЯ со значением НАИМЕНОВАНИЯ1, а всё что помимо удалить (Тоесть то чего нет ни в том ни в другом столбце) но при этом ЦЕНА должна остаться привязана к значению в столбце НАИМЕНОВАНИЕ? За ранее спасибо!