VBA: Как заменить значение ячейки Excel на основе её содержимого?

У меня есть таблица Excel с некоторыми именами в ячейках. В одной ячейке может быть как одно имя, так и несколько имен.

Например: Ячейка A5 содержит “Joe”, ячейка BD54 содержит “Joe;Harry;Molly”, ячейка YY1 содержит “Harry;Butch”.

Что я хочу сделать, так это заменить значения всех ячеек, содержащих “Joe” или “Molly”, на “1”, независимо от того, что еще находится в этих ячейках, а ячейки, содержащие только “Harry” или “Butch”, будут заменены на “0”, если они не содержат “Joe” или “Molly”. Для вышеуказанного примера результат должен быть следующим: A5 содержит “1”, BD54 содержит “1”, YY1 содержит “0”.

Я полный новичок в VBA – не могли бы вы, джентльмены, помочь мне с этим? Я подозреваю, что здесь следует использовать Cells.Replace, однако, я не уверен, как передать список имен в него

Dim Findtext As String
 Dim Replacetext As String
 Findtext = "Joe","Molly"
 Replacetext = "1"
 Findtext = "Harry","Butch"
 Replacetext = "0"
 Cells.Replace What:=Findtext, Replacement:=Replacetext, LookAt:=xlPart, _
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 ReplaceFormat:=False 

Вы на правильном пути, но вместо этого можно сделать что-то такое, используя instr –

Sub test()
Dim check1 As Integer
Dim check2 As Integer
Dim find1 As String
find1 = "a"
Dim find2 As String
find2 = "b"
For Each c In Range("A:A")
    check1 = InStr(1, c, find1, 1)
    check2 = InStr(1, c, find2, 1)
        If check1 > 0 Then
            c.Value = 1
        End If
        If check2 > 0 Then
            c.Value = 2
        End If
Next

End Sub

В основном, она ищет в ячейке положение строки поиска. Если она не находит его, она возвращается к 0. Таким образом, если она его находит, то check1 или check2 будут больше 0. Если она находит обе строки, то возвращается к последнему if.

Чтобы сделать это немного более универсальным… вы могли бы иметь список имен для поиска, которые нужно заменить, где-то на вашем листе. Вы бы получили каждый из диапазонов для замены на Один и Нуль соответственно, затем прошлись бы по (выбранному) целевому диапазону, выполняя замены.

У меня были данные такого вида:

Option Explicit

Public Sub DirtyHarry()

Dim target_range As Range
Dim search_names_range As Range

'select the range you want to do the replace on before you start!
Set target_range = Selection

'do the ones first
Set search_names_range = Sheet1.Range("E2:E" & Sheet1.Range("E2").End(xlDown).Row)
BinaryReplaceBleepBloop search_names_range, target_range, 1

'now do the zeroes
Set search_names_range = Sheet1.Range("G2:G" & Sheet1.Range("G2").End(xlDown).Row)
BinaryReplaceBleepBloop search_names_range, target_range, 0

End Sub

Private Function BinaryReplaceBleepBloop(search_names As Range, target_range As Range, replacement_value As Integer)

Dim search_string_cell As Object
Dim target_cell As Object
Dim this_name As String

Debug.Print "Searching " & target_range.AddressLocal & " for the names in " & search_names.AddressLocal & " to replace with " & replacement_value

'loop through each of the search names
For Each search_string_cell In search_names.Cells

    this_name = search_string_cell.Value

    Debug.Print "..." & this_name

    'loop through each of the cells in the selected target range
    For Each target_cell In target_range.Cells

        Debug.Print "......target_cell value is " & target_cell.Value

        If InStr(1, target_cell.Value, this_name) > 0 Then

            Debug.Print "......Found it! Replacing " & target_cell.Value & " with " & replacement_value

            target_cell.Value = replacement_value

        Else

            Debug.Print "......Didn't find it. Nothing to see here."

        End If

    Next target_cell

Next search_string_cell

End Function

Вывод в окне Immediate выглядел так, когда я запустил его: