如何让VBA宏循环遍历11组三列以汇总假期数据？

我来帮你搞定这个循环遍历所有月份列组的需求！你的现有代码已经能处理第一组（A-C列），只需要在外层加一个按3列步进的循环，就能覆盖到所有12个月的列组（直到AJ列，也就是第36列）。另外，我还会帮你优化代码，去掉Select和Selection这类容易出错且低效的操作，让宏运行更稳定快速。

核心思路 #

每个月对应3列一组，所以我们可以用一个外层循环，从第1列（A列）开始，每次步进3列（Step 3），直到第36列（AJ列），这样就能依次遍历每一组的日期、时长、状态列。然后在每组内，检查该组的第二列（休假时长）是否大于0.1，符合条件就复制整组三列到Sheet4。

优化后的完整代码 #

Sub CopyACross()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastrow As Long, i As Long, erow As Long
    Dim colStart As Long ' 每组的起始列
    
    ' 提前定义工作表对象，避免重复引用
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet4")
    
    ' 关闭屏幕更新和事件，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 外层循环：遍历所有12组三列（从第1列到第36列，每次加3）
    For colStart = 1 To 36 Step 3
        ' 获取当前组起始列的最后一行数据
        lastrow = wsSource.Cells(Rows.Count, colStart).End(xlUp).Row
        
        ' 内层循环：遍历当前组的每一行
        For i = 2 To lastrow
            ' 检查当前组的第二列（休假时长）是否大于0.1
            If wsSource.Cells(i, colStart + 1).Value > 0.1 Then
                ' 获取Sheet4的下一个空行
                erow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                ' 复制当前行的三列数据到Sheet4
                wsSource.Range(wsSource.Cells(i, colStart), wsSource.Cells(i, colStart + 2)).Copy _
                    Destination:=wsTarget.Cells(erow, 1)
            End If
        Next i
    Next colStart
    
    ' 恢复屏幕更新和事件
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "假期数据汇总完成！", vbInformation
End Sub

关键改进点说明 #

• 外层循环Step 3：For colStart = 1 To 36 Step 3会让colStart依次取1、4、7...36，正好对应每个月的起始列（A、D、G...AJ）。
• 避免Select操作：直接通过工作表对象（wsSource、wsTarget）引用单元格，不仅运行更快，还能避免因手动切换工作表导致的错误。
• 性能优化：关闭ScreenUpdating和EnableEvents可以大幅提升宏的运行速度，尤其是数据量较大的时候。
• 鲁棒性提升：提前定义工作表对象，避免因工作表重命名导致的代码失效（如果需要修改工作表名称，只需改一次Set语句即可）。

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