提取不重复值及对应的第二个最大值

缔造者

要求：
VBA
提取A列不重复值及对应的B列时间第二个最大值。
注意：有两个相同的最大值时，其第二个最大值就是两个最大值中的一个。

日期时间第二大值.rar (5.45 KB, 下载次数: 38)

2013-10-23 22:39 上传

点击文件名下载附件

缔造者

各位E家豪杰，走过路过，千万不要错过！
请求帮助！

山菊花

请测试。

缔造者

山菊花 发表于 2013-10-24 09:21
请测试。

谢谢美女版主！
相信你，不会错！

缔造者

山菊花 发表于 2013-10-24 09:21
请测试。

版主你好！
经测试，发现有点小错误，个别第二大值不正确。

山菊花

是忽略了这种情况。
楼上附件已更新，请重新下载并测试。

缔造者

山菊花 发表于 2013-10-24 11:48
是忽略了这种情况。
楼上附件已更新，请重新下载并测试。

没看到更新！又重新下载了，还是原附件。
版主，请再抽点小空，纠正一下吧。谢谢您！！

山菊花

不会是原附件的，你确认一下打开的是否新的文件。或者自己更新一下代码：
Sub tiqu()
    Dim ds, nRow%, n%, m%, Arr(), Brr()
    Set ds = CreateObject("scripting.dictionary") '定义字典
    nRow = Range("a65536").End(xlUp).Row
    Arr = Range("a2:b" & nRow).Value
    ReDim Brr(1 To nRow, 1 To 3)
    For i = 1 To nRow - 1
        n = ds(Arr(i, 1))
        If n = 0 Then
            m = m + 1
            n = m
            ds(Arr(i, 1)) = m
            Brr(m, 1) = Arr(i, 1)
            Brr(m, 3) = Arr(i, 2)
        End If
        If Arr(i, 2) >= Brr(n, 3) Then
            Brr(n, 2) = Brr(n, 3)
            Brr(n, 3) = Arr(i, 2)
        ElseIf Arr(i, 2) > Brr(n, 2) Then
            Brr(n, 2) = Arr(i, 2)        
　　End If
    Next
    Range("f2:g" & nRow).Value = Brr
End Sub

缔造者

山菊花 发表于 2013-10-24 12:34
不会是原附件的，你确认一下打开的是否新的文件。或者自己更新一下代码：
Sub tiqu()
    Dim ds, nRow%, ...

测试了几个数据，貌似还有点错误。比如朱小兵的第二大值应该是2011-7-27 15:03，但程序运行的结果却是它的最大值2013-7-17 15:03

jsxjd

F2、G2公式，下拉：

1. =INDEX(A:A,SMALL(IF(MATCH(A$2:A$26,A$2:A$26,)=ROW($1:$25),ROW($2:$26),4^8),ROW()-1))&""
   

复制代码

1. =LARGE(IF(A$2:A$26=F2,B$2:B$26),2)

复制代码