NickHK
12/13/2006 9:49:00 AM
Slight correction;
You should of course being using
'Get the Minimum value
MinValue = Application.Min(InData)
And I suppose you should delete
'First value is always valid
OutArray(LArray) = InData(LArray, 1)
UniqueCount = LArray
And change to
For i = LArray To UArray
And add error/array checking.
NickHK
"NickHK" <TungCheWah@Invalid.com> wrote in message
news:O5MSoppHHHA.1276@TK2MSFTNGP04.phx.gbl...
> Eric,
> Not well tested, but may be this ;
> Private Sub CommandButton2_Click()
> Dim RetVals() As Long
> Dim i As Long
>
> RetVals = SortSpecial(Range("rngData").Value)
>
> For i = LBound(RetVals) To UBound(RetVals)
> Debug.Print RetVals(i)
> Next
>
> End Sub
>
> Private Function SortSpecial(InData As Variant) As Long()
> Dim OutArray() As Long
> Dim LArray As Long
> Dim UArray As Long
> Dim MinValue As Long ' Single
> Dim i As Long
> Dim j As Long
> Dim UniqueCount As Long
>
> LArray = LBound(InData, 1)
> UArray = UBound(InData, 1)
>
> 'Avoid many Redim Preserve, assume 100% required
> ReDim OutArray(LArray To UArray)
>
> 'Get the Minimum value
> MinValue = Application.Min(Range("rngData"))
>
> 'First value is always valid
> OutArray(LArray) = InData(LArray, 1)
> UniqueCount = LArray
>
> For i = LArray + 1 To UArray
> 'make sure it is NOT the minimum value
> If (InData(i, 1) <> MinValue) Then
> 'See if it meets the minimum difference requirement
> For j = LArray To UniqueCount
> If (Abs(InData(i, 1) - OutArray(j)) <= MinValue) Then
> GoTo BreakOut
> End If
> Next
>
> 'See if we have that value already
> For j = LArray To UniqueCount
> If InData(i, 1) = OutArray(j) Then
> GoTo BreakOut
> End If
> Next
> UniqueCount = UniqueCount + 1
> OutArray(UniqueCount) = InData(i, 1)
> BreakOut:
> End If
> Next
>
> 'Redim to remove unused elements
> ReDim Preserve OutArray(LArray To UniqueCount)
> SortSpecial = OutArray()
>
> End Function
>
> NickHK
>
> "Eric" <Eric@discussions.microsoft.com> wrote in message
> news:AA23D782-BF22-4FB9-9404-759A32FD515C@microsoft.com...
> > Referring to Excel General Question
> > Does anyone know how to perform this kind of sorting in excel?
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> >
> > The above values are listed from cell A1 to A14
> > A1 has a higher priority than A2 on selection, and A14 has the lowest
> > priority on selection, because it located on the bottom of the list. I
> need
> > to select the top five numbers from the list without duplication, but
the
> > distance between any two numbers must be bigger than / [equal to] the
> > smallest value from the list. On the other words, 2 is the smallest
number
> > from the list,
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> > the first number is 13 for selection, and
> > [13]
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> > the second number is 8, which 13-8=5 and is bigger than / equal to the
> > smallest number 2.
> > [13 8]
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> > the third number cannot be 7, because abs(8-7)=1, which is less than the
> > smallest number 2, even through abs(13-7)=6, which is bigger than 2.
> > the next third number cannot be 7 again, then skip it for the next one.
> > the next third number cannot be 14, because abs(13-14)=1, which is less
> than
> > 2.
> > ...
> > the next third number is 3, abs(13-3)=10, abs(8-3)=5, which is bigger
than
> 2
> > [13 8 3]
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> > the next forth number is 23, which is OK, abs(13-23)=10, abs(8-23)=15,
> which
> > is bigger than 2
> > [13 8 3 23]
> >
> > 13, 8, 7, 7, 14, 14, 14, 3, 3, 3, 23, 19, 2, 2
> > the next fifth number is 19, abs(13-19)=6, abs(8-19)=11, abs(23-19)=4,
> > abs(3-19)=16
> >
> > [13 8 3 23 19] DONE, which values are stored in cell B1 to B5
> >
> > Does any have any suggestion?
> > Thank you very much in advance
> > Eric
>
>