使用IsDate条件跨Excel工作簿复制工时数据的VBA调试

需求说明 #

实现跨Excel工作簿提取各日期对应总工时，自动过滤工时为0的日期记录，写入目标工作表。当前在按条件筛选源数据环节逻辑出错，原有代码如下：

Public Sub hour_count_update()

Dim wb_source As Worksheet, wb_dest As Worksheet
Dim source_month As Range
Dim source_date As Range
Dim dest_month As Range

Set wb_source = Workbooks("2022_Onyva_Ore Personale Billing.xlsx").Worksheets("AMETI")
Set wb_dest = Workbooks("MACRO ORE BILLING 2022.xlsm").Worksheets("RiepilogoOre")
Set dest_month = wb_dest.Cells(wb_dest.Rows.Count, "B") _
        .End(xlUp)

wb_dest.Range("A2:C600").Clear 'cancella dati del foglio RiepilogoOre

For Each source_month In wb_source.Range("A1:A600")
    If source_month.Interior.Color = RGB(255, 255, 0) Then
        For Each source_date In source_month.Offset(1, 0).EntireRow
            If IsDate(source_date) Then
                MsgBox "It is a date"
                Set dest_month = dest_month.Offset(1)
                dest_month.Value = source_date.Value
            End If
        Next source_date
    End If
Next source_month

End Sub

参考工作表截图 #

• 源工作簿：
  
• 目标工作簿：
  
• 预期输出效果：
  

原有代码问题 #

• 遍历逻辑错误：EntireRow会遍历整行超百万个单元格，效率极低，且会误判非数据区域的日期格式值
• 缺少工时读取、0值过滤逻辑，没有提取对应日期的总工时字段
• 目标写入位置初始化逻辑错误：清空目标区域后直接取B列最后一行会定位到表头，偏移后写入会覆盖表头
• 变量命名歧义：以wb_前缀命名Worksheet类型变量，容易混淆工作簿、工作表对象，引发后续逻辑错误

修正后可运行代码 #

Public Sub hour_count_update()
    Dim ws_source As Worksheet, ws_dest As Worksheet
    Dim source_month_cell As Range
    Dim source_date_cell As Range
    Dim dest_write_row As Long
    Dim total_hours As Variant
    
    ' 绑定源、目标工作表
    Set ws_source = Workbooks("2022_Onyva_Ore Personale Billing.xlsx").Worksheets("AMETI")
    Set ws_dest = Workbooks("MACRO ORE BILLING 2022.xlsm").Worksheets("RiepilogoOre")
    
    ' 清空目标区域旧数据，初始化写入行（第2行，第1行为表头）
    ws_dest.Range("A2:C600").ClearContents
    dest_write_row = 2
    
    ' 遍历A列查找黄色填充的月份标记行
    For Each source_month_cell In ws_source.Range("A1:A600")
        If source_month_cell.Interior.Color = RGB(255, 255, 0) Then
            ' 仅遍历月份行下一行的有效数据列（从第2列开始到最后一个有值的列）
            For Each source_date_cell In ws_source.Range( _
                ws_source.Cells(source_month_cell.Row + 1, 2), _
                ws_source.Cells(source_month_cell.Row + 1, ws_source.Columns.Count).End(xlToLeft))
                
                If IsDate(source_date_cell.Value) Then
                    ' 读取当前日期列最底部的汇总工时值
                    total_hours = ws_source.Cells(ws_source.Rows.Count, source_date_cell.Column).End(xlUp).Value
                    
                    ' 过滤0值、空值的工时记录
                    If IsNumeric(total_hours) And total_hours > 0 Then
                        ' 如需写入月份，可取消下一行注释，将source_month_cell的值写入A列
                        ' ws_dest.Cells(dest_write_row, "A").Value = source_month_cell.Value
                        ws_dest.Cells(dest_write_row, "B").Value = source_date_cell.Value
                        ws_dest.Cells(dest_write_row, "C").Value = total_hours
                        dest_write_row = dest_write_row + 1
                    End If
                End If
            Next source_date_cell
        End If
    Next source_month_cell
End Sub

代码说明 #

• 匹配源表结构：默认每个日期列最底部的数值为当日总工时，和提供的源表截图结构一致
• 自动跳过工时为0、空值的日期记录，符合过滤要求
• 仅遍历有效数据区域，运行效率远高于整行遍历
• 预留了A列月份写入的代码，取消注释即可自动填充对应月份

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