Hi Charles,
That's blinding!
I had not forgotten your original comments re speed and
loop vs function overheads. I had established that looping
was faster for a single operation such as simply getting
the minimum. But I was way off finding an efficient loop
to get the ten smallest, such as you have just
demonstrated.
Part of your trick, I think, is that "FindLargest" is only
called about 50 times with 2500 rows, and just slightly
more with 10000 (I added a counter). If anything your code
should be relatively quicker with increasing qantities.
I just need to sort the ten smallest before returning
relative values from the 2nd column, adding to the last
part of your code:
For j = 1 To nSmalls
' dAnsa(j) = vArr(iSmallIX(j), 2)
Cells(j, 3).Resize(1, 2) = _
Array(vArr(iSmallIX(j), 1), iSmallIX(j))
Next
Range("C1").Resize(nSmalls, 2).Sort Key1:=Range("C1")
For j = 1 To nSmalls
dAnsa(j) = vArr(Cells(j, 4), 2)
'iSmallIX(j) = Cells(j, 4)
'Cells(j, 6) = dAnsa(j)
'Cells(j, 5) = vArr(iSmallIX(j), 1)
Next
A sixth sense tells me you wouldn't do it this way, but
it's only 10x2!
Where speed and/or quantity are issues, not to mention the
5461 element limit with functions in XL97 (perhaps also
XL2000?), your results and methods are conclusive.
I still like Dana's neat and lean Index and Match method,
which I will use where these issues are not relevant.
With both your help I've learnt a lot about handling
arrays over the last few days.
Thank you very much,
Paul
-----Original Message-----
Hi Paul & Dana,
Dana's solution is very elegant but looping seems to be
much faster on my
system using Excel97 :
Demo3 takes about 48 milliseconds on my system for 2500
rows.
The looping solution below takes about 1.6 millisecs for
2500 rows (and does
not have the 5468 array function limit), and its pretty
much linear with the
number of rows (10000 rows takes about 5.6 millisecs)
Option Explicit
Option Base 1
Private Declare Function getFrequency Lib "kernel32" Alias
"QueryPerformanceFrequency" (cyFrequency As Currency) As
Long
Private Declare Function getTickCount Lib "kernel32" Alias
"QueryPerformanceCounter" (cyTickCount As Currency) As
Long
Public Function MicroTimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency
10 MicroTimer = 0
20 If cyFrequency = 0 Then getFrequency cyFrequency
30 getTickCount cyTicks1
40 If cyFrequency Then MicroTimer = cyTicks1 /
cyFrequency
End Function
Sub FindSmallest()
Dim vArr As Variant
Dim iLargeIX As Long
Dim dSmallNums() As Double
Dim iSmallIX() As Long
Dim j As Long
Dim dAnsa() As Double
Dim dtime As Double
Dim nSmalls As Long
Dim nRows As Long
nSmalls = 10
nRows = 2500
vArr = Worksheets("Sheet1").Range("a1").Resize(nRows, 2)
ReDim dSmallNums(nSmalls) As Double
ReDim iSmallIX(nSmalls) As Long
ReDim dAnsa(nSmalls) As Double
dtime = MicroTimer()
For j = 1 To nSmalls
dSmallNums(j) = vArr(j, 1)
iSmallIX(j) = j
Next j
iLargeIX = FindLargest(dSmallNums)
For j = nSmalls + 1 To nRows
If vArr(j, 1) < dSmallNums(iLargeIX) Then
dSmallNums(iLargeIX) = vArr(j, 1)
iSmallIX(iLargeIX) = j
iLargeIX = FindLargest(dSmallNums)
End If
Next j
For j = 1 To nSmalls
dAnsa(j) = vArr(iSmallIX(j), 2)
Next j
dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub
Function FindLargest(dSmallNums() As Double) As Long
Dim j As Long
Dim dLarge As Double
dLarge = dSmallNums(1)
FindLargest = 1
For j = 2 To UBound(dSmallNums)
If dSmallNums(j) dLarge Then
FindLargest = j
dLarge = dSmallNums(j)
End If
Next j
End Function
Sub Demo3()
'// Dana DeLouis, adapted
Dim v, MinLeft, ValueRight
Dim Column1
Dim i As Long
Dim dtime As Double
v = [A1:B2500]
dtime = MicroTimer()
With WorksheetFunction
'Keep next line out of loop...
Column1 = .Index(v, 0, 1)
For i = 1 To 10
MinLeft = .Small(Column1, i)
ValueRight = .Index(v, .Match(MinLeft,
Column1, 0), 2)
'Cells(i, 3).Resize(1, 2) = Array(MinLeft,
ValueRight)
Next i
End With
dtime = MicroTimer() - dtime
MsgBox dtime * 1000 & " Millisecs"
End Sub
Charles
______________________
Decision Models
FastExcel Version 2 now available.
www.DecisionModels.com