Question

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

两个输入：

数据
百分比，指出应排除原始数据样本中的数据点数

我的初稿（见下文）现在错过了两个功能：

当我使用该功能并选择整列（例如= TrimMIN（A：A））时需要很长时间
我需要对输入范围＆＃39;数据＆＃39;进行排序。在修剪它之前，但行＆＃39; data.Cells.Sort＆＃39;

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

我的代码：

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

这是一个有效的功能。

理想情况下，您可以根据功能将适当的范围作为参数......

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

获得＆＃34;修剪最小值＆＃34;，类似于Excel TRIMMEAN功能

1 个答案: