Question

我想在VBA中创建一个宏来识别ID的第一个日期和最后一个日期，然后以小时为单位格式化它们之间的减法结果。

这是我的表格的一个例子：

 ID         DATE   
 001        11/11/2013 
 001        11/21/2013
 001        11/25/2013
 002        12/04/2013
 002        12/05/2013
 003        12/05/2013
 001        11/23/2013

期望的结果：

 ID         DATE           RESULT IN HOURS (Last Date - First Date)
 001        11/11/2013     =(11/25/2013)-(11/11/2013)
 001        11/21/2013
 001        11/25/2013
 002        12/04/2013     =(12/05/2013)-(12/04/2013) 
 002        12/05/2013
 003        12/05/2013
 001        11/23/2005

在当前表格中，有2个或更多重复的ID具有不同的日期，您可以在001 ID样本中看到。

我的第一个解决方案是按ID和日期对表格进行排序，然后应用Countif公式来获取重复ID，但我只能通过ID识别第一个日期并错过最后日期。

我非常感谢你的帮助。谢谢！

Answer 1

好的问题。我喜欢收藏品的使用，因为它们非常快。必须有多种方法来解决这样的问题，以下是一个例子：

Sub jzz()
Dim cArray() As Variant
Dim lastRow As Long

Dim rw As Long
Dim i As Long

Dim firstDate As Date
Dim lastDate As Date
Dim id As Long
Dim idColl As Collection

Set idColl = New Collection

'determine last row:
lastRow = Cells.SpecialCells(xlLastCell).Row

'if you plan to loop the cells repeatedly,
'the use of an array to hold cell values pays off, performancewise
cArray = Range(Cells(1, 1), Cells(lastRow, 2)).Value

For rw = 1 To lastRow
    id = Cells(rw, 1)
    'determine if id is used or not:
    For i = 1 To idColl.Count
        If idColl(i) = id Then GoTo nextRow
    Next i
    'id is not in collection, add it:
    idColl.Add id
    firstDate = cArray(rw, 2)
    lastDate = 0
    'loop array to find first and last dates:
    For i = LBound(cArray) To UBound(cArray)
        If cArray(i, 1) = id Then
            If cArray(i, 2) < firstDate Then firstDate = cArray(i, 2)
            If cArray(i, 2) > lastDate Then lastDate = cArray(i, 2)
        End If
    Next i
    Debug.Print id, firstDate, lastDate
nextRow:
Next rw
End Sub

Private Function TimeDiffHours(T0 As Date, T1 As Date) As String
'function that returns the difference between T0 and T1 in hours:mins
TimeDiffHours = Int((T1 - T0) * 24) & ":" _
                & Format(Round(((T1 - T0) * 24 - Int((T1 - T0) * 24)) * 60, 0), "00")
End Function

请注意，这只会查找每个ID的第一个和最后一个日期，并将其打印出来，以及时间差：小时：分钟。它没有做任何事情，甚至没有保存结果。这取决于你。

VBA宏按重复ID减去日期

1 个答案: