修改Excel VBA代码：按姓名独立检查F-K列并填充Yes

原代码由@FaneDuru编写，原本用于检查H、I列，当同一姓名对应的两列均为"yes"时，自动为该姓名所有行的H、I列填充"yes"。现在需要调整代码，实现以下目标：

• 检查范围改为F列（第6列）到K列（第11列）
• 每列独立处理：若某姓名在某一列存在"Yes"，仅为该姓名在同一列的空白行填充"Yes"，不会影响其他列

修改后的VBA代码 #

Sub fillYesPerColumn()
    Dim sh As Worksheet, lastR As Long, arrData As Variant
    Dim col As Long, i As Long, dict As Object
    
    Set sh = ActiveSheet
    lastR = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
    '加载A列到K列的数据到数组，提升处理速度
    arrData = sh.Range("A2:K" & lastR).Value2
    
    '遍历F到K列（第6到第11列），每列单独处理
    For col = 6 To 11
        Set dict = CreateObject("Scripting.Dictionary")
        '第一步：收集当前列中存在"Yes"的姓名
        For i = 1 To UBound(arrData)
            If UCase(arrData(i, col)) = "YES" Then
                dict(arrData(i, 1)) = 1 '用字典记录符合条件的姓名
            End If
        Next i
        
        '第二步：为当前列中符合条件的姓名空白行填充"Yes"
        For i = 1 To UBound(arrData)
            If dict.Exists(arrData(i, 1)) And arrData(i, col) = "" Then
                arrData(i, col) = "Yes"
            End If
        Next i
    Next col
    
    '将处理后的数组批量写回工作表
    sh.Range("A2").Resize(UBound(arrData), UBound(arrData, 2)).Value2 = arrData
End Sub

关键改动说明 #

• 列独立处理逻辑：通过循环遍历F到K列（第6到11列），每列单独创建字典记录存在"Yes"的姓名，彻底避免列之间的干扰
• 大小写兼容：用UCase()统一判断条件，避免因大小写不一致（如"YES"/"yes"/"Yes"）导致的漏判
• 批量操作优化：全程基于数组处理，最后一次性写回工作表，相比逐单元格操作大幅提升效率
• 精准填充规则：增加arrData(i, col) = ""的判断，仅对空白单元格填充，保留已有内容不变

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