如何在Excel VBA中找到基于特定范围的最高值和最低值

Question

我从几个参考文献中得到了这段代码，以找到最高和最低的分数：

还有一件事让我很好奇，我如何在拥有数千个数据的特定范围内实现这些代码？

示例：当我想找到Sheet1中包含的B2:B4000范围内的10或30个最高数据值，并将结果放入Sheet1的C2范围时，就会运行该代码？

Function Max(ParamArray values() As Variant) As Variant
Dim maxValue, Value As Variant
maxValue = values(0)
For Each Value In values
If Value > maxValue Then maxValue = Value
Next
Max = maxValue
End Function
Function Min(ParamArray values() As Variant) As Variant
Dim minValue, Value As Variant
minValue = values(0)
For Each Value In values
If Value < minValue Then minValue = Value
Next
Min = minValue
End Function

Answer 1

请尝试下一个代码：

Sub LargestInRange_array()
Dim sh As Worksheet, arr, nrR As Long, i As Long

Set sh = ActiveSheet             'use here the sheet you need
arr = sh.Range("B2:B4000").Value 'put the range in an array

nrR = 5 'the number of Top to be returned (that 10 to 30, in your question)
'clear the previous returned Top:
sh.Range("C2:C" & sh.Range("C" & sh.rows.count).End(xlUp).row).ClearContents
For i = 1 To nrR
sh.Range("C" & i + 1).Value = WorksheetFunction.Large(arr, i)
Next i
End Sub

它在变量nrR中放置您设置的最大值，从"0"开始；C2"；。

编辑：

请尝试使用函数并且只需要一个范围和Top数字的版本。它确定要处理的列中的最后一行：

Sub testTopXSales()
Dim sh As Worksheet, rng As Range, arrTop, lastR

Set sh = ActiveSheet                   'use here the sheet you need
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in the range to be processed
    'adapt "B" to the column you use
Set rng = sh.Range("B2:B" & lastR)      'use here the range to be processed
rng.Offset(0, 1).EntireColumn.ClearContents 'clear the clumn to the right contents
arrTop = TopXSales(rng, 10)              'defining the Top array, using the function

'drop the array content in the next column:
rng.Offset(0, 1).Resize(UBound(arrTop) + 1, 1).Value = Application.Transpose(arrTop)
End Sub
Function TopXSales(rng As Range, TopNr As Long) As Variant
Dim arr, arrTop, i As Long, k As Long
ReDim arrTop(TopNr - 1) 'redim the array to keep the largest value (- 1 because it is a 1D array starting from 0)
arr = rng.Value              'put the range in an array. It will work with the range itself, but it should be faster so
For i = 0 To TopNr - 1    'creating the Top array
arrTop(k) = WorksheetFunction.Large(arr, i + 1): k = k + 1
Next i
TopXSales = arrTop       'make the function to return the Top array
End Function

Answer 2

Hy也许它会帮助你摆脱

Private Sub hy()

Dim foo As Object
Set foo = test(3)

Dim i As Integer
For i = 0 To foo.count - 1
Debug.Print foo(i)
Next i

End Sub

Function test(count As Integer) As Object
Dim arr As Object
Set arr = CreateObject("System.Collections.ArrayList")

arr.Add 70
arr.Add 30
arr.Add 60
arr.Add 50
arr.Add 200
arr.Add 10
arr.Sort

Set test = CreateObject("System.Collections.ArrayList")

Dim i As Integer
For i = arr.count - 1 To arr.count - count Step -1
test.Add arr(i)
Next i


End Function