VBA代码优化需求：遍历2000行判断单元格值并写入指定列

看你现在的情况，重复写了一堆几乎一模一样的代码，自己尝试改循环的时候没处理好范围偏移的逻辑，而且原来的代码依赖Select和ActiveCell操作，这种写法不仅冗余还容易出错。我来帮你把代码改得简洁高效。

先说说你尝试的循环代码哪里出问题了： #

• 语法错误：Set Range = rng.Offset(1, 0)这里写错了，应该是Set rng = rng.Offset(1, 0)，不能直接给Range这个关键字赋值
• 依赖Select和ActiveCell会让代码不稳定，运行效率也低，一旦工作表焦点变动，代码就容易出问题
• 循环次数只写了100次，没覆盖到你需要的2000行数据

给你两个优化后的方案，按需选择： #

方案1：高效判断（用CountIf，无需逐个单元格循环）

这个方法最快，直接用Excel的CountIf函数判断当前行的BD到CI列是否存在"Y"，不用遍历每个单元格：

Sub MarkRowsWithY()
    Dim ws As Worksheet
    Dim i As Long
    
    ' 替换成你实际要操作的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 从第5行遍历到第2004行（要处理2000行数据，从5开始的话终点是5+1999=2004）
    For i = 5 To 2004
        ' 检查当前行BD到CI列是否存在值为"Y"的单元格
        If WorksheetFunction.CountIf(ws.Range("BD" & i & ":CI" & i), "Y") > 0 Then
            ' 在当前行的首列（这里假设是A列，不是的话修改列号）写入"Y"
            ws.Cells(i, 1).Value = "Y"
        End If
    Next i
End Sub

方案2：保留逐单元格检查逻辑（优化写法）

如果你还是想逐个单元格确认，也可以这么写，同样避免使用Select：

Sub MarkRowsWithY_CellLoop()
    Dim ws As Worksheet
    Dim rowRange As Range
    Dim cell As Range
    Dim i As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    For i = 5 To 2004
        Set rowRange = ws.Range("BD" & i & ":CI" & i)
        ' 遍历当前行的BD到CI列
        For Each cell In rowRange
            If cell.Value = "Y" Then
                ws.Cells(i, 1).Value = "Y"
                Exit For ' 找到一个Y就停止检查当前行，节省时间
            End If
        Next cell
    Next i
End Sub

几个关键优化点： #

• 彻底抛弃Select和ActiveCell，直接通过工作表对象操作单元格，代码更稳定，不会因为点击其他区域就出错
• 用循环变量i直接构造每行的范围，逻辑更清晰，不用手动偏移
• 方案1的CountIf方法效率高很多，处理2000行数据时速度会快不少
• 如果你的“首列”不是A列，把ws.Cells(i, 1)里的1改成对应的列号（比如BC列是第55列，就写55）

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