VBA如何遍历电子表格并将数据保存到集合中（中间有空单元格）

Question

我现在有这张表（缩短版）。问题是有一些空单元格，这是我试图通过只保存带有值的单元格然后打印出来来摆脱的：

Full name	Work Begin	Break	Work End	Total Hours
Alex	01/06/2022 08:00		01/06/2022 15:42	7,7
Alex	02/06/2022 08:00		02/06/2022 15:42	7,7
Alex	03/06/2022 08:00
Alex
Alex
Alex		00:30:00
Alex			03/06/2022 14:45	6,25
Alex	07/06/2022 08:00	01:30:00
Alex
Alex		00:30:00
Alex
Alex
Alex
Alex
Alex			07/06/2022 17:15	7,75

运行宏后的预期结果应该是：

Full name	Work Begin	Break	Work End	Total Hours
Alex	01/06/2022 08:00	00:00:00	01/06/2022 15:42	7,7
Alex	02/06/2022 08:00	00:00:00	02/06/2022 15:42	7,7
Alex	03/06/2022 08:00	00:30:00	03/06/2022 14:45	6,25
Alex	07/06/2022 08:00	02:00:00	07/06/2022 17:15	7,75

我当前使用的以下 ode 做了类似但不是我想要的（https://stackoverflow.com/a/19314880/19500408）：

Sub OTHours()
    Dim c As Collection
    Set c = New Collection
    Dim e As Collection
    Set e = New Collection
    On Error GoTo RowHandler
    Dim i As Long, r As Range
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set r = Range("M" & i)
        c.Add r.Row, r.Offset(0, -12) & "£" & r
    Next i

    For i = 1 To c.Count
        If i <> c.Count Then
            Dim j As Long
            j = c.Item(i)

            Dim m As Merged
            Set m = New Merged

            m.Name = Range("A" & c.Item(i))
            m.Dates = Range("M" & c.Item(i))

            Do Until j = c.Item(i + 1)
                m.Hours = m.Hours + Range("L" & j)
                m.Row = j
                j = j + 1
            Loop
        Else
            Dim k As Long
            k = c.Item(i)
            
            Set m = New Merged

            m.Name = Range("A" & c.Item(i))
            m.Dates = Range("M" & c.Item(i))
           
            Do Until IsEmpty(Range("A" & k))
                m.Hours = m.Hours + Range("L" & k)
                
                m.Row = k
                k = k + 1
            Loop
        End If
        e.Add m
    Next i

    For i = 1 To e.Count
        Debug.Print e.Item(i).Name, e.Item(i).Dates, e.Item(i).Hours, e.Item(i).Row
        Range("P" & e.Item(i).Row) = IIf(e.Item(i).Hours - 7.7 > 0, e.Item(i).Hours - 7.7, vbNullString)
    Next i

    PrintOvertime e

    Exit Sub

RowHandler:
    Resume Next
End Sub


Private Sub PrintOvertime(e As Collection)
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If StrComp(ws.Name, "Time Only", vbTextCompare) = 0 Then ws.Delete
    Next
    Application.DisplayAlerts = True
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Time Only"
    Set ws = Sheets("Time Only")
    With ws
        Dim i As Long
        .Range("A1") = "Applicant Name"
        .Range("B1") = "Date"
        .Range("C1") = "hours"
        For i = 1 To e.Count
            If (e.Item(i).Hours - 0 > 0) Then
                .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Name
                .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Dates
                .Range("C" & .Range("C" & Rows.Count).End(xlUp).Row + 1) = e.Item(i).Hours - 0
            End If
        Next i
        .Columns.AutoFit
    End With
End Sub

此代码的问题如下：

• 由于单元格为空，某些值为 0
• 一些值重叠

结果我需要什么：

• VBA 中的代码，它遍历整个表并将值存储在变量（类组件）中。

注意：

• 忽略时间重叠
• 如果工作开始时间和工作结束时间之间有两个休息时间，则需要将它们加在一起
• 如果 Break 为空，则在变量中添加 00:00（在 VBA 中）
• 全名因过滤器而异

Answer 1

以下内容可能会对您有所帮助。这不是您所要求的一切，但我会带您走上正轨。

以下代码假定您的表位于 A1:E16 范围内（16 行数据，5 列）。它将读取该数据并将其压缩为您提供的四行数据、5 列作为预期结果。它将这些数据写入 K:O 列（原始数据偏移 10 列）。

Dim x As Long, y As Long, z As Long, v As Variant
z = 2
For y = 2 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).row
    For x = 1 To 5
        v = Cells(y, x).Value
        If v = "" And x = 3 Then v = 0
        If v <> "" Then
            If x = 3 Then
                Cells(z, 10 + x) = Cells(z, 10 + x) + v
            Else
                Cells(z, 10 + x) = v
            End If
        End If
        If v <> "" And x = 5 Then z = z + 1
    Next
Next

注意：总小时数列必须有一个代表每一天的值，因为这用于标识每条记录的结束。