使用Offset结合CountIf统计指定条件数据的VBA实现求助

需求明确 #

遍历工作表Seguimiento的第4行至最后一行，当某行C列值为Diario时，统计该行W列中Cumple的出现次数，并根据第2行的目标日期（如3/1/2022）将结果输出到对应日期列的指定位置。

原代码问题分析 #

1. pruebaestadisticas问题 #

• CountIf参数为单个单元格，无法实现统计，仅能判断单个单元格是否为Cumple
• 行循环与列循环嵌套导致重复赋值，逻辑冗余
• 未做累加处理，每次赋值都会覆盖之前结果

2. pruebaestadisticas2问题 #

• 所有统计结果写入固定单元格W33，循环中持续覆盖，最终仅保留最后一次循环结果
• 不必要的列循环，无需遍历所有列判断日期

正确实现代码 #

场景1：统计所有符合条件行的W列Cumple总次数 #

针对第2行指定日期列输出统计结果：

Sub EstadisticasCumple()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim targetDate As Date
    Dim targetCol As Range
    Dim count As Long
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    Set ws = ThisWorkbook.Sheets("Seguimiento")
    lastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row
    targetDate = DateSerial(2022, 1, 3) ' 用DateSerial规避日期格式差异
    
    ' 定位第2行的目标日期列
    Set targetCol = ws.Rows(2).Find(What:=targetDate, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not targetCol Is Nothing Then
        count = 0
        ' 遍历行统计符合条件的数据
        For x = 4 To lastRow
            If ws.Cells(x, "C").Value = "Diario" And ws.Cells(x, "W").Value = "Cumple" Then
                count = count + 1
            End If
        Next x
        
        ' 将结果写入目标日期列的最后一行右侧单元格（可根据需求调整位置）
        targetCol.Offset(lastRow - 2, 1).Value = count
    Else
        MsgBox "未找到目标日期：" & Format(targetDate, "m/d/yyyy")
    End If
    
    Application.ScreenUpdating = True
End Sub

场景2：按第2行日期列批量统计对应列数据 #

遍历第2行所有日期列，统计各列中C列为Diario且单元格值为Cumple的数量：

Sub EstadisticasPorFecha()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dateCols As Range
    Dim c As Range
    Dim count As Long
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    Set ws = ThisWorkbook.Sheets("Seguimiento")
    lastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row
    ' 假设第2行日期列从D列开始，可根据实际调整范围
    Set dateCols = ws.Range("D2", ws.Cells(2, ws.Columns.count).End(xlToLeft))
    
    For Each c In dateCols
        count = 0
        For x = 4 To lastRow
            If ws.Cells(x, "C").Value = "Diario" And ws.Cells(x, c.Column).Value = "Cumple" Then
                count = count + 1
            End If
        Next x
        ' 将结果写入该日期列的最后一行下方
        ws.Cells(lastRow + 1, c.Column).Value = count
    Next c
    
    Application.ScreenUpdating = True
End Sub

优化说明 #

• 使用DateSerial定义目标日期，避免系统日期格式差异导致的匹配失败
• 先定位目标列/批量获取日期列，减少不必要的循环，提升效率
• 添加错误提示（场景1），增强代码健壮性
• 关闭屏幕更新，提升运行速度

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