Ms access VBA宏以重复ID减去日期

我想在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识别第一个日期，而缺少最后一个日期

---

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

好问题。我喜欢使用集合，因为它们非常快。解决这样的问题必须有很多方法，下面是一个例子：

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

子jzz（）
Dim cArray（）作为变体
最后一排一样长
变暗rw为长
我想我会坚持多久
将firstDate变为Date
将lastDate变为Date
我的身份证很长
Dim idColl As集合
Set idColl=新集合
'确定最后一行：
lastRow=单元格。特殊单元格（xlLastCell）。行
“如果您计划重复循环单元格，
'使用数组来保存单元格值是值得的，从性能上看
cArray=范围（单元格（1，1），单元格（最后一行，2））。值
对于rw=1至最后一行
id=单元（rw，1）
'确定是否使用了id：
对于i=1到idColl.Count
如果idColl（i）=id，则转到下一步
接下来我
'id不在集合中，请添加它：
添加id
firstDate=cArray（rw，2）
lastDate=0
'循环数组以查找第一个和最后一个日期：
对于i=LBound（cArray）至UBound（cArray）
如果cArray（i，1）=id，则
如果cArray（i，2）lastDate，则lastDate=cArray（i，2）
如果结束
接下来我
调试。打印id，firstDate，lastDate
下一步：
下一个rw
端接头
私有函数TimeDiffHours（T0作为日期，T1作为日期）作为字符串
'返回T0和T1之间的差值（小时：分钟）的函数
TimeDiffHours=Int（（T1-T0）*24）和“：”_
&格式（圆形（（T1-T0）*24-整数（（T1-T0）*24））*60,0，“00”）
端函数

---

请注意，这只会找到每个id的第一个和最后一个日期，并将其打印出来，以及以小时：分钟为单位的时差。它什么也不做，甚至不保存结果。这取决于您。

您可以使用max if公式获取最后日期：您是在使用excel表格还是access表格？在access中，我将使用基于查询的解决方案，而在excel中，您必须“遍历”表格。两种截然不同的beastsGreat解决方案。我向代码中添加以下行以获得结果：Cells（rw，3）。Value=id Cells（rw，4）。Value=firstDate Cells（rw，5）.Value=lastDate但是我的第一个ID日期出现了一些错误。它会为每个ID获取第一个ID的第一个日期。我一直在疯狂地尝试修复它，但我找不到解决方案。ID显示的最后一个日期工作得很好。将firstDate=cArray（1，2）更改为firstDate=cArray（rw，2）。我认为应该这样做。我会稍后再查，因为我现在正在打电话。