搜索具有特定文本的所有单元格的范围并将所有相邻单元格的值更改为 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

此外，我还有一个命令按钮，它将 select 仅显示非空白的单元格。我需要上面的结果，因为如果下面的代码 selects 来自列 E:F 的非空白单元格，它不会 selecting 与包含“住宿和交通”的单元格相邻的单元格，因为它们是空白单元格它将 return 错误“运行时错误‘1004’此操作不适用于多个 select 离子”。

下面的代码与 [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

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

Search range for all cells with specific text and change the value of all adjacent cell to 0

excel

search

vba