獲得「最小修剪」，與Excel相似TRIMMEAN功能

Question

我想在Excel中實現一個自定義函數，該函數返回修剪後的數據樣本的最小值。

兩個輸入：

• 數據
• 百分比，其中規定從原始數據樣本多少個數據點應排除

我的第一個草案（如下所示），射門的兩個特徵現在：

1. 當我使用fu並選擇一個整列（例如， G。 = TrimMIN（A：A）），需要花費很長的時間
2. 我需要修剪它，但線「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

這是一個工作的功能。

理想的情況下它是由你來放置在適當的範圍作爲參數傳遞給funtion ...

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