VBA函数开发需求：按日期计算并填充人均每日案件量至指定行

我完全明白你的需求啦，咱们先把核心逻辑再明确一遍，避免偏差：

• 数据源是E3:L7区域，目标是填充第14行的黄色高亮单元格
• 第12行的工作日数是其他函数生成的，咱们不用改动它
• 计算规则分两种情况：
  • 第一组（对应数据源第3行）：直接计算 H列值 / J列值 / K列值，结果填充到E14到K14的对应日期列
  • 第二组及以后（数据源第4、5、6、7行）：计算当前行的 H/J/K 比值后，加上上一行的累计结果，再填充到对应的日期列（比如第4行对应L14-N14）
• 旧代码的问题在于逻辑没覆盖累计计算，还在日期判断上绕了弯路，咱们直接按行和列的对应关系来实现更准确

下面是修正后的VBA代码，我已经做了注释，你可以直接用：

Sub CalculateDailyCasesPerPerson()
    Dim ws As Worksheet
    Dim dataStartRow As Long, dataEndRow As Long
    Dim dataStartCol As Long, currentDataCol As Long
    Dim targetRow As Long
    Dim currentRatio As Double, cumulativeRatio As Double
    
    ' 设置工作表和关键参数
    Set ws = ThisWorkbook.Sheets("sheet1")
    dataStartRow = 3 ' 数据源起始行（第3行）
    dataEndRow = 7 ' 数据源结束行（第7行）
    dataStartCol = 5 ' 数据源起始列（E列）
    targetRow = 14 ' 目标填充行（第14行）
    
    ' 先清空目标行的旧数据
    ws.Range(ws.Cells(targetRow, dataStartCol), ws.Cells(targetRow, ws.Columns.Count)).ClearContents
    
    ' 初始化累计值为0
    cumulativeRatio = 0
    
    ' 遍历每一行数据源
    For i = dataStartRow To dataEndRow
        ' 计算当前行的基础比值：H列(第8列)/J列(第10列)/K列(第11列)
        If ws.Cells(i, 10).Value <> 0 And ws.Cells(i, 11).Value <> 0 Then ' 避免除以0报错
            currentRatio = ws.Cells(i, 8).Value / ws.Cells(i, 10).Value / ws.Cells(i, 11).Value
        Else
            currentRatio = 0 ' 如果J或K列是0，赋值为0避免错误
        End If
        
        ' 计算累计比值：第一行直接用currentRatio，后续行加上之前的累计值
        If i = dataStartRow Then
            cumulativeRatio = currentRatio
        Else
            cumulativeRatio = cumulativeRatio + currentRatio
        End If
        
        ' 确定当前行要填充的目标列范围：
        ' 第一行从E列(dataStartCol)到K列(第11列)
        ' 后续行从当前行起始列的下一列开始，到对应结束列（比如第4行从L列(12)开始）
        Dim targetStartCol As Long, targetEndCol As Long
        If i = dataStartRow Then
            targetStartCol = dataStartCol
            targetEndCol = 11 ' K列
        Else
            targetStartCol = ws.Cells(i - 1, dataStartCol).End(xlToRight).Column + 1
            ' 如果当前行有数据，取到最后一个非空列；如果没有，就停在起始列
            targetEndCol = ws.Cells(i, dataStartCol).End(xlToRight).Column
            ' 处理当前行没有数据的情况，避免填充空列
            If targetEndCol < dataStartCol Then targetEndCol = targetStartCol
        End If
        
        ' 把累计比值填充到目标列范围
        ws.Range(ws.Cells(targetRow, targetStartCol), ws.Cells(targetRow, targetEndCol)).Value = cumulativeRatio
    Next i
    
    MsgBox "计算完成！", vbInformation
End Sub

代码关键说明： #

• 避免除以0错误：加了判断J列和K列不为0的逻辑，防止运行时报错
• 累计值处理：第一行直接用基础比值，后续行自动累加之前的结果，完全符合你要的累计逻辑
• 动态列范围：自动识别每一行数据源对应的目标列，就算后续第5-7行新增数据，也能自动适配
• 清空旧数据：每次运行先清空第14行的旧内容，避免残留数据干扰

你可以直接把这段代码替换掉原来的funcX，然后运行试试。如果还有调整需求（比如列范围的识别逻辑），随时告诉我就行！

备注：内容来源于stack exchange，提问作者Jresearcher