如何将Excel VBA While循环批量应用至整列数据？

需求与问题 #

工作表内PO至PX列存储数据，需为每一行执行计算：当第1行的表头值≤当前行QJ列的值时，累加该行中符合条件的所有值，并将结果写入对应行的QK列。现有代码仅对第2行生效，需适配到剩余563行（总计565行数据）。

原代码：

Sub test()

i = Range("QJ2")
Dim intx As Integer

Do While i > 0 And i <= Range("QJ2")
    If i = Range("QJ2") Then
        intx = WorksheetFunction.Hlookup(i, Range("PO1:PX565"), 2, False)
    Else
        intx = intx + WorksheetFunction.Hlookup(i, Range("PO1:PX565"), 2, False)
    End If

    i = i - 1
Loop
ActiveCell.Value = intx
End Sub

修改后的代码 #

Sub CalculateQKColumn()
    Dim ws As Worksheet
    Dim lastRow As Integer
    Dim currentRow As Integer
    Dim targetValue As Integer
    Dim sumResult As Integer
    Dim headerRange As Range
    
    ' 指定目标工作表，替换成你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = 565 ' 数据总行数，可按需调整
    
    ' 定义表头范围（PO1到PX1）
    Set headerRange = ws.Range("PO1:PX1")
    
    ' 遍历第2行到最后一行
    For currentRow = 2 To lastRow
        targetValue = ws.Cells(currentRow, "QJ").Value
        sumResult = 0
        
        ' 逐个检查表头值，符合条件则累加对应行的单元格内容
        Dim headerCell As Range
        For Each headerCell In headerRange
            If headerCell.Value <= targetValue Then
                sumResult = sumResult + ws.Cells(currentRow, headerCell.Column).Value
            End If
        Next headerCell
        
        ' 将计算结果写入QK列对应行
        ws.Cells(currentRow, "QK").Value = sumResult
    Next currentRow
End Sub

关键修改说明 #

• 新增行循环：用For currentRow = 2 To lastRow遍历所有需要处理的行，不再固定只处理第2行
• 替换查找逻辑：直接遍历表头列判断条件，比原代码的Hlookup循环更高效，也避免了查找匹配失败的风险
• 移除依赖ActiveCell：直接定位QK列单元格写入结果，操作更稳定
• 添加工作表对象引用：明确指定操作的工作表，避免切换工作表时出错

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