如何用VBA按分组范围批量填充H列：判断样本是否全低于LLOQ

问题背景 #

需要为Excel工作表「Cyt-Data」的H列批量填充内容，数据已按Test（E列）、Subject ID（C列）、Timepoint排序，需按Test+Subject ID分组进行判断填充。目前已实现G列的基线判断逻辑，但无法准确定位分组范围完成H列的批量处理。

填充规则 #

• 按Test（E列）与Subject ID（C列）的组合作为分组依据，同一Subject ID对应多个Test及数据点
• I列标记为"Yes"时，代表对应数据未检测到（对应J列值为"<LLOQ"）
• 若分组内所有行的I列均为"Yes"，则该组所有行的H列填"Yes"；否则填"No"

现有G列实现代码 #

Sub BaselineBelowLLOQ()

    Sheets("Cyt-Data").Activate
    Dim NewSubject As String
    Dim SubjectBL As String
    Dim BaselineRow As Integer

    For i = 2 To 1000000
        If Sheets("Cyt-Data").Cells(i, 2).Value = "" Then
            Exit For
        End If
        
        NewSubject = Cells(i, 3).Value
        
        If Not SubjectBL = NewSubject And Cells(i, 4).Value = "C01D01.00" Then
            SubjectBL = NewSubject
            BaselineRow = i
        ElseIf Not SubjectBL = NewSubject And Not Cells(i, 4).Value = "C01D01.00" Then
            SubjectBL = ""
        End If
    
        
        If Not SubjectBL = "" Then
            If Cells(BaselineRow, 9).Value = "Yes" Then
                Cells(i, 7).Value = "Yes"
            Else
                Cells(i, 7).Value = "No"
            End If
        End If
    Next i

End Sub

H列批量填充解决方案代码 #

Sub FillColumnH()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Cyt-Data")
    
    ' 获取数据最后一行（基于Subject ID列）
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    Dim currentTest As String, currentSubject As String
    Dim groupStartRow As Long, groupEndRow As Long
    Dim allYes As Boolean
    Dim i As Long, j As Long
    
    ' 初始化第一组的起始行与分组标识
    groupStartRow = 2
    currentTest = ws.Cells(groupStartRow, "E").Value
    currentSubject = ws.Cells(groupStartRow, "C").Value
    
    ' 遍历数据，处理每个分组
    For i = 2 To lastRow + 1
        ' 触发分组处理条件：到达新分组/最后一行
        If i > lastRow Or ws.Cells(i, "E").Value <> currentTest Or ws.Cells(i, "C").Value <> currentSubject Then
            groupEndRow = i - 1
            
            ' 判断当前分组内I列是否全为"Yes"
            allYes = True
            For j = groupStartRow To groupEndRow
                If ws.Cells(j, "I").Value <> "Yes" Then
                    allYes = False
                    Exit For ' 存在非"Yes"值，提前终止判断
                End If
            Next j
            
            ' 批量填充当前分组的H列
            ws.Range(ws.Cells(groupStartRow, "H"), ws.Cells(groupEndRow, "H")).Value = IIf(allYes, "Yes", "No")
            
            ' 更新分组信息，准备处理下一组
            If i <= lastRow Then
                groupStartRow = i
                currentTest = ws.Cells(i, "E").Value
                currentSubject = ws.Cells(i, "C").Value
            End If
        End If
    Next i
End Sub

代码说明 #

1. 动态获取数据范围：通过lastRow自动定位数据最后一行，避免硬编码行数导致的遗漏或无效循环
2. 分组跟踪：通过currentTest和currentSubject跟踪当前分组，当分组标识变化时处理当前组
3. 性能优化：判断分组内是否全为"Yes"时，只要发现非"Yes"值立即终止循环，减少不必要的计算
4. 批量填充：对整个分组的H列一次性赋值，比逐行填充效率更高，尤其适合大数据量场景

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