获得“最小修剪”，类似于Excel TRIMMEANfunction

我想在Excel中实现一个自定义函数，它返回一个修剪的数据样本的最小值。

两个input：

• 数据
• 百分比，指出原始数据样本中应该排除多less个数据点

我的初稿（见下面）现在错过了两个特点：

1. 当我使用函数并select一个整列（例如= TrimMIN（A：A））时，需要很长时间
2. 我需要sortinginput范围'数据'之前修剪，但行'data.Cells.Sort'不起作用

期待在这两个问题上得到一些想法。

我的代码：

Function TrimMIN(data As Range, percentage As Double) As Double Dim dataNew As Range Dim dataNewS As Variant Dim diff, counter, upper, lower, countDataNew As Double counter = 0 'data.Cells.Sort diff = Round(data.Count * percentage / 2, [0]) Debug.Print "diff= " & diff upper = data.Count - diff lower = diff countDataNew = data.Count - diff - diff 'Application.Min(data) 'Debug.Print "upper= " & upper 'Debug.Print "lower= " & lower 'Debug.Print "data.count= " & data.count 'Debug.Print "countDataNew= " & countDataNew Dim cel As Range For Each cel In data.Cells counter = counter + 1 'Debug.Print "counter= " & counter Debug.Print "celValue= " & cel.Value If counter > lower And counter <= upper Then 'Debug.Print "counter in range, counter is " & counter If Not dataNew Is Nothing Then ' Add the 2nd, 3rd, 4th etc cell to our new range, rng2 ' this is the most common outcome so place it first in the IF test (faster coding) Set dataNew = Union(dataNew, cel) Else ' the first valid cell becomes rng2 Set dataNew = cel End If End If Next cel 'Debug.Print "dataNew.count " & dataNew.count TrimMIN = Application.Min(dataNew) End Function 

Answer 1

这是一个工作function。

理想情况下，您可以select适当的范围作为function的参数。

 Public Function TrimMin(data As Range, percentage As Double) As Double Dim usedData As Variant 'avoid calculating entire columns or rows usedData = Intersect(data, data.Parent.UsedRange).Value Dim x As Long, y As Long x = UBound(usedData) - LBound(usedData) + 1 y = UBound(usedData, 2) - LBound(usedData, 2) + 1 Dim arr() As Variant ReDim arr(1 To x * y) Dim i As Long, j As Long, counter As Long counter = 1 For i = 1 To x For j = 1 To y If Application.WorksheetFunction.IsNumber(usedData(i, j)) Then arr(counter) = usedData(i, j) counter = counter + 1 End If Next j Next i ReDim Preserve arr(1 To counter - 1) Dim diff As Long diff = Round((counter - 1) * percentage / 2, 0) + 1 'use the worksheet function to obtain the appropriate small value TrimMin = Application.WorksheetFunction.Small(usedData, diff) End Function