从索引位置的给定范围中提取唯一的Max和Min值

Question

请看下面给出的代码。它完成了工作，但代码提供了包括重复的值。 （见输出）

我无法弄清楚如何提取唯一值而不是重复值。

 S.No   Values
 1      99.501
 2      99.441
 3      99.346
 4      99.683
 5      99.683
 6      99.941
 7      99.326
 8      99.315
 9      99.326
10      99.564
11      99.565
12      99.513
13      99.396
14      99.676
15      99.083
16      99.083
17      98.886
18      99.129
19      99.129
20      99.73

我的代码：

Sub MaxMin()

    Dim Rng As Range, Dn As Range, Lg As String
    Dim n As Long, c As Long, nRay As Variant
    Dim Sm As String, Sp As Variant, ac As Long
    Dim col As Integer, R As Long, t
    Set Rng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp))
    For n = 1 To 5
        Lg = Lg & IIf(Lg = "", Application.Large(Rng, n), "," _
                        & Application.Large(Rng, n))
        Sm = Sm & IIf(Sm = "", Application.Small(Rng, n), "," _ 
                        & Application.Small(Rng, n))
    Next n
    Sp = Array(Split(Lg, ","), Split(Sm, ","))
    ReDim Ray(1 To 11, 1 To 4)
    Ray(1, 1) = "S.No"
    Ray(1, 2) = "Max"
    Ray(1, 3) = "S.No"
    Ray(1, 4) = "Min"
    For ac = 0 To 1
        col = IIf(ac = 0, 1, 3)
        c = 0
        nRay = Range(Range("A2"), Range("b" & Rows.Count).End(xlUp)).Resize(, 2)
        c = 1
        For n = 0 To 4
            For R = 1 To UBound(nRay, 1)
                If Not IsEmpty(nRay(R, 2)) And nRay(R, 2) = Val(Sp(ac)(n)) Then
                    c = c + 1
                    Ray(c, col) = nRay(R, 1)
                    Ray(c, col + 1) = nRay(R, 2)
                    nRay(R, 2) = ""
                    Exit For
                End If
            Next R
        Next n
    Next ac
    Range("F1").Resize(6, 4).Value = Ray
End Sub

输出：

S.No    Max     S.No    Min
6       99.941  17      98.886
20      99.73   15      99.083
4       99.683  16      99.083
5       99.683  18      99.129
14      99.676  19      99.129

修改后的代码不应仅包含“重复”的“唯一”5个最大值和5分钟的值以及它们的索引位置。

Answer 1

您可以使用Dictionary Object来获得QHarr所指的结果，如下所示。

Public Sub GetMinMax()
Dim objDict As Object
Dim i As Long
Set objDict = CreateObject("Scripting.Dictionary")
'\\ Add uniques to list
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
    If Not objDict.exists(Range("B" & i).Value) Then objDict.Add Range("B" & i).Value, Range("A" & i).Value
Next
'\\ Populate output columns
Range("F1").Resize(1, 4).Value = Array("S.No.", "Max", "S.No.", "Min")
For i = 1 To 5
    Range("G" & i + 1).Value = Application.Large(objDict.keys, i)
    Range("F" & i + 1).Value = objDict.Item(Range("G" & i + 1).Value)
    Range("I" & i + 1).Value = Application.Small(objDict.keys, i)
    Range("H" & i + 1).Value = objDict.Item(Range("I" & i + 1).Value)
Next
End Sub