如何修改VBA代码实现批量查找BI列的"drek"并偏移赋值？

嘿，这个问题我刚学VBA的时候也踩过坑！你的代码里Range.Find确实只会返回第一个匹配的单元格，所以处理完第一个就停了。要搞定所有匹配项，得用FindNext配合循环来遍历，这样就能把BI列里所有含"drek"的单元格都处理到。

给你修改后的代码：

Sub find_drek()
    Dim rng As Range
    Dim cl As Range
    Dim firstFound As String
    Dim sFind As String
    
    sFind = "drek"
    ' 确定查找范围，新版本Excel建议用Rows.Count代替65536
    Set rng = Range("BI2", Range("BI" & Rows.Count).End(xlUp))
    
    ' 定位第一个匹配项
    Set cl = rng.Find(sFind, LookIn:=xlValues)
    
    If Not cl Is Nothing Then
        firstFound = cl.Address ' 记录第一个匹配地址，防止无限循环
        Do
            ' 给右侧相邻单元格赋值"1"
            cl.Offset(0, 1).Value = "1"
            ' 查找下一个匹配项
            Set cl = rng.FindNext(cl)
            ' 循环终止条件：找不到下一项，或者回到第一个匹配项
        Loop While Not cl Is Nothing And cl.Address <> firstFound
    End If
End Sub

关键改动说明： #

• 新增firstFound变量：这是避免无限循环的核心！FindNext在遍历完所有匹配项后会回到第一个，记录初始地址就能判断是否已经遍历完一轮。
• 用Do...Loop循环：重复执行"处理单元格→查找下一个"的逻辑，直到没有更多匹配项。
• 优化范围定位：用Range("BI" & Rows.Count).End(xlUp)代替固定的BI65536，适配Excel 2007及以后的版本（这些版本行数远多于65536）。

如果还有其他问题，随时问哈！

内容的提问来源于stack exchange，提问作者jhew123