搜索具有特定文本的所有单元格的范围并将所有相邻单元格的值更改为 0

Question

寻求帮助以实现搜索包含“住宿和运输”的所有单元格的所有单元格 E9:E 并将与它们相邻的单元格的值更改为 0。，我无法在线获得任何类似主题的内容而且我不太擅长 VBA 编码，尽管我能够理解代码将在结果中提供什么。

我有一个带有以下代码的 Commandbutton1：

Sub CommandButton1_click()

Dim blanks As Excel.Range

Set blanks = Range("F9:F" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)

blanks.Value = blanks.Offset(0, -1).Value

End Sub

此外，我还有一个命令按钮，它将仅选择非空白单元格。我需要上面的结果，因为如果下面的代码从 E:F 列中选择非空白单元格，它将不会选择与包含“住宿和运输”的单元格相邻的单元格，因为它们是空白单元格，它将返回错误“运行时错误'1004'此操作不适用于多项选择”。

下面的代码与[Go to Special => Constants]作用相同

Sub SelectNonBlankCells()

Dim rng As Range
Dim OutRng As Range
Dim InputRng As Range
Dim xTitle As String


On Error Resume Next

xTitle = Application.ActiveWindow.RangeSelection.Address

Set InputRng = Range("E8:F500")

ActiveWindow.ScrollRow = 1

For Each rng In InputRng

If Not rng.Value = "" Then

If OutRng Is Nothing Then

Set OutRng = rng

Else

Set OutRng = Application.Union(OutRng, rng)

End If

End If

Next

If Not (OutRng Is Nothing) Then

OutRng.Select

End If

End Sub

Answer 1

如果您的目标是编辑与某些单元格相邻的单元格，也许您可​​以尝试另一种方法。以下代码基于Range.Find函数帮助文件中的示例：

Sub DoSomething()

    Dim sh As Worksheet
    Set sh = ActiveSheet
    
    Dim checkRange As Range
    Set checkRange = sh.Range("E8:F500") ' your intended range to search
    
    Dim foundRange As Range
    Set foundRange = checkRange.Find("Accommodation & Transportation")
    
    Dim firstAddr As String
    
    If Not foundRange Is Nothing Then
    
        firstAddr = foundRange.Address
        Do
        
            ' use foundRange to access adjacent cells with foundRange.Offset(row, col)
            '
            '
            foundRange.Offset(0, 1) = "all good"
            
            Set foundRange = checkRange.FindNext(foundRange)
            
        Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
    End If

End Sub

或者更好的是，您可以添加一些参数以使其更具可重用性：

Sub Main()

    DoSomething "Accommodation & Transportation", ActiveSheet.Range("E8:F500")

End Sub


Sub DoSomething(ByVal findWhat As String, ByVal searchWhere As Range)

    Dim foundRange As Range
    Set foundRange = searchWhere.Find(findWhat)
    
    Dim firstAddr As String
    
    If Not foundRange Is Nothing Then
    
        firstAddr = foundRange.Address
        Do
        
            ' use foundRange to access adjacent cells with foundRange.Offset(row, col)
            '
            '
            foundRange.Offset(0, 1) = "all good"
            
            Set foundRange = searchWhere.FindNext(foundRange)
            
        Loop While Not foundRange Is Nothing And foundRange.Address <> firstAddr
    End If

End Sub