VBA：如何根据内容替换整个 Excel 单元格的值？

Question

我有一个 Excel 电子表格，其中的单元格中有一些姓名。每个单元格可以有一个姓名，也可以在一个单元格中有多个姓名。

例如：单元格 A5 包含“Joe”，单元格 BD54 包含“Joe;Harry;Molly”，单元格 YY1 包含“Harry;Butch”。

我想要实现的是将所有包含“Joe”或“Molly”的单元格的值替换为“1”，而不管这些单元格中还有什么，而仅包含“Harry”或“Butch”的单元格如果不包含“Joe”或“Molly”，则将被替换为“0”。例如，结果应如下：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 

Answer 1

你走在正确的轨道上，但你可以做这样的事情，使用指令-

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整数。

Answer 2

为了让事情更通用一点...您可以在工作表的某个地方列出要替换的搜索名称列表。您将获得分别用“一”和“零”替换的每个范围，然后循环遍历（选定的）目标范围，进行替换。

我有这样的数据：

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

当我运行它时，“立即”窗口中的输出如下所示：