VBA按日期列提取每日最值问题及代码优化咨询

你遇到的第一个月1号数据遗漏第一条的问题，根源在于Range.Find方法的默认参数行为：当不指定After参数时，Excel会从指定范围的第一个单元格之后开始搜索。你的数据范围是C2:C&Lastrow，默认After是C2，所以搜索会从C3开始——如果1号的第一条数据恰好就在C2，那这个单元格会被直接跳过，导致后续循环完全没处理它！

另外，代码还有一个隐藏问题：Md变量在每次Dia循环开始时没有重置为0，这会导致跨日期的累加值污染，计算出来的平均值肯定是错误的，只是在其他日期没表现得这么明显。

修复后的现有代码 #

下面是修正后的核心循环代码，解决了上述两个问题：

For Dia = 1 To 31
    Dim targetDate As Date
    targetDate = DateSerial(Año, Mes, Dia)
    
    ' 修复Find的问题：指定After为范围最后一个单元格，强制从第一个单元格开始搜索
    Dim findResult As Range
    Set findResult = Sht.Range("C2", "C" & Lastrow).Find(What:=targetDate, _
        After:=Sht.Range("C" & Lastrow), LookAt:=xlWhole, SearchDirection:=xlNext)
    
    ' 找不到当天数据时直接跳过，避免报错
    If findResult Is Nothing Then
        Md = 0
        s = 1 ' 避免除以0错误
        GoTo WriteResult
    End If
    
    Cuenta = findResult.Row
    s = 0
    maxVal = 0 ' 变量名避开VBA关键字max
    minVal = 0
    Md = 0 ' 每次循环重置累加值！
    
    While Sht.Range("C" & Cuenta).Value = targetDate
        s = s + 1
        currentVal = Sht.Range("B" & Cuenta).Value
        
        ' 初始化最值
        If s = 1 Then
            maxVal = currentVal
            minVal = currentVal
        Else
            ' 更新最值
            If currentVal > maxVal Then maxVal = currentVal
            If currentVal < minVal Then minVal = currentVal
        End If
        
        Md = Md + currentVal
        Cuenta = Cuenta + 1
        
        ' 防止超出数据表范围报错
        If Cuenta > Lastrow Then Exit While
    Wend
    
    ' 计算平均值，双重保险处理无数据情况
    If s > 0 Then
        Md = Md / s
    Else
        Md = 0
    End If
    
WriteResult:
    ' 写入结果
    WS.Cells(Dia + 2, 3 * (Mes - 1) + 2) = minVal
    WS.Cells(Dia + 2, 3 * (Mes - 1) + 3) = Md
    WS.Cells(Dia + 2, 3 * (Mes - 1) + 4) = maxVal
Next Dia

主要修复点：

• 显式指定Find参数：将After设为范围最后一个单元格，强制从C2开始搜索；加上LookAt:=xlWhole确保完全匹配日期值，避免部分匹配问题。
• 每次Dia循环开始时重置Md为0，避免累加值污染。
• 增加无数据判断，防止运行时错误。
• 变量名避开VBA内置关键字，减少潜在冲突。
• 增加越界判断，避免循环超出数据范围。

更简便的实现方式：利用Excel内置函数 #

完全不用手动循环遍历，VBA可以直接调用Excel的MAXIFS、MINIFS、AVERAGEIFS函数，一行代码就能得到结果，效率更高也更可靠：

For Dia = 1 To 31
    Dim targetDate As Date
    targetDate = DateSerial(Año, Mes, Dia)
    Dim colOffset As Integer
    colOffset = 3 * (Mes - 1) + 2
    
    ' 直接调用工作表函数计算最值和平均值
    On Error Resume Next ' 处理无数据的情况
    WS.Cells(Dia + 2, colOffset) = WorksheetFunction.MinIfs(Sht.Range("B:B"), Sht.Range("C:C"), targetDate)
    WS.Cells(Dia + 2, colOffset + 1) = WorksheetFunction.AverageIfs(Sht.Range("B:B"), Sht.Range("C:C"), targetDate)
    WS.Cells(Dia + 2, colOffset + 2) = WorksheetFunction.MaxIfs(Sht.Range("B:B"), Sht.Range("C:C"), targetDate)
    On Error GoTo 0 ' 恢复错误处理
    
    ' 无数据时填充默认值，可根据需求调整
    If IsEmpty(WS.Cells(Dia + 2, colOffset)) Then
        WS.Cells(Dia + 2, colOffset).Resize(1, 3).Value = 0
    End If
Next Dia

这个方法的优势： #

• 代码简洁：省去手动循环、累加、判断的繁琐步骤。
• 效率更高：Excel内置函数经过优化，处理大量数据时比VBA循环快得多。
• 更可靠：避免手动循环可能出现的边界错误、变量初始化错误等问题。

如果你的Excel版本较旧（2016及以前）没有MAXIFS/MINIFS，可以用Dictionary对象分组统计，只遍历一次原始数据，效率更高：

' 用Dictionary分组所有日期的数据，一次性计算结果
Dim dateDict As Object
Set dateDict = CreateObject("Scripting.Dictionary")

' 遍历所有数据行，分组统计
For i = 2 To Lastrow
    currentDate = Sht.Range("C" & i).Value
    currentVal = Sht.Range("B" & i).Value
    
    If Not dateDict.Exists(currentDate) Then
        ' 首次遇到该日期，初始化数组：(最小值, 最大值, 总和, 计数)
        dateDict(currentDate) = Array(currentVal, currentVal, currentVal, 1)
    Else
        ' 更新统计值
        Dim stats As Variant
        stats = dateDict(currentDate)
        stats(0) = IIf(currentVal < stats(0), currentVal, stats(0)) ' 最小值
        stats(1) = IIf(currentVal > stats(1), currentVal, stats(1)) ' 最大值
        stats(2) = stats(2) + currentVal ' 总和
        stats(3) = stats(3) + 1 ' 计数
        dateDict(currentDate) = stats
    End If
Next i

' 遍历月份和日期，从Dictionary中取出结果
For Mes = 1 To 12 ' 假设处理全年12个月
    For Dia = 1 To 31
        targetDate = DateSerial(Año, Mes, Dia)
        colOffset = 3 * (Mes - 1) + 2
        
        If dateDict.Exists(targetDate) Then
            stats = dateDict(targetDate)
            WS.Cells(Dia + 2, colOffset) = stats(0)
            WS.Cells(Dia + 2, colOffset + 1) = stats(2) / stats(3)
            WS.Cells(Dia + 2, colOffset + 2) = stats(1)
        Else
            ' 无数据时填充默认值
            WS.Cells(Dia + 2, colOffset).Resize(1, 3).Value = 0
        End If
    Next Dia
Next Mes

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