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

Please have a look at the following given code. It does the work but the code gives the values including the duplicates. (see the output)

请看下面给出的代码。它完成工作,但代码提供包括重复的值。 (见输出)

I couldn't figure out how to extract unique vales instead of duplicates.

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

 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

My code:

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

Output:

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

The modified code should not include "duplicate" only "unique" 5 max and 5 min values with their index positions.

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

1 个解决方案

#1

You can use Dictionary Object to get such results which QHarr is referring to like below.

你可以使用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