使用 IsDate 条件将值从一个工作簿复制到另一个工作簿

Answer 1

好的，首先，让您的代码正常工作，这似乎只是 msgbox 并拉出任何日期：

我不知道为什么，但是当我运行它时，VBA 不喜欢这条线：

    For Each source_date In source_month.Offset(1, 0).EntireRow

通过将该行替换为：

        For Each source_date In source_month.Offset(1, 0).Resize(, 100)

代码似乎运行良好（这里我做了 100 列，但您可以轻松地将其更改为更多）

接下来，您正在填充所有日期，并且您只想要具有值的日期并且您想要该值，因此我认为您需要类似的东西：

                For Each rng In source_date.Resize(100, 0)
                    If rng.Interior.Color = RGB(255, 255, 255) Then
                        hoursWorked = rng.Value
                    End If
                Next rng

其中 rng 是一个范围，RGB 是总小时数的背景颜色

把它放在一起你会得到：

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
Dim rng As Range


Set wb_source = ActiveWorkbook.Worksheets("Sheet19")
Set wb_dest = ActiveWorkbook.Worksheets("Sheet20")
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")
    source_month.Select
    If source_month.Interior.Color = RGB(255, 255, 0) Then
        For Each source_date In source_month.Offset(1, 0).Resize(, 100)
            If IsDate(source_date.Value) Then
            
                For Each rng In source_date.Resize(100, 0)
                    If rng.Interior.Color = RGB(255, 255, 255) Then
                        hoursWorked = rng.Value
                    End If
                Next rng
            
            
                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

我还没有测试工作时间，你可以看到我没有对它们做任何事情

请让我知道您的进展情况，或者我是否可以提供更多帮助！

Answer 2

我已经设法解决了项目的这一部分。 正如 user1236777 所指出的 .EntireRow 的行为，我仍然必须找出原因。 .Resize 创造了奇迹。

然后我让 ArrayLists 过滤掉小时等于 0 的日期。这就是出现的问题。 感谢帮助！

Public Sub hour_count_update2()

'Dichiarazioni
Dim wb_source As Worksheet, wb_dest As Worksheet
Dim source_month As Range
Dim source_date As Range
Dim dest_month As Range
Dim source_total_hours As Range
Dim source_hours
Dim dest_hours As Range
Dim dest_name As Range
Dim date_list As ArrayList
    Set date_list = New ArrayList
Dim hours_list As ArrayList
    Set hours_list = New ArrayList

Set wb_source = Workbooks("2022_Onyva_Ore Personale Billing.xlsx").Worksheets("AMETI")
Set wb_dest = Workbooks("MACRO ORE BILLING 2022.xlsm").Worksheets("RiepilogoOre")

wb_dest.Range("A2:C600").Clear

Set dest_name = wb_dest.Cells(wb_dest.Rows.Count, "A") _
        .End(xlUp)
Set dest_month = wb_dest.Cells(wb_dest.Rows.Count, "B") _
        .End(xlUp)
Set dest_hours = wb_dest.Cells(wb_dest.Rows.Count, "C") _
        .End(xlUp)

For Each source_total_hours In wb_source.Range("B130")
    If source_total_hours = "TOTALE ORE" Then
        For Each source_hours In source_total_hours.Offset(0, 3).Resize(, 50)
            If IsNumeric(source_hours) Then
                hours_list.Add (source_hours)
            End If
        Next source_hours
    End If
Next source_total_hours

For Each source_month In wb_source.Range("A1:A600")
    If source_month.Value = "01/05/2022" Then
        For Each source_date In source_month.Offset(1, 0).Resize(, 50)
            If IsDate(source_date) Then
                date_list.Add (source_date)
            End If
        Next source_date
    End If
Next source_month

For Each i In hours_list
    If i <> 0 Then
        Set dest_month = dest_month.Offset(1)
            dest_month.Value = date_list(0)
            date_list.RemoveAt 0
        Set dest_hours = dest_hours.Offset(1)
            dest_hours.Value = i
        Set dest_name = dest_name.Offset(1)
            dest_name.Value = wb_source.Range("B1")
    Else: On Error Resume Next
        date_list.RemoveAt 0
    End If
Next i

End Sub