Question

我想在值数组上应用用户定义的聚合函数（来自特定单元格的字符串值，如"SUM"或"STDEV"）。这是一个简化的例子。但是我不知道如何进行聚合（最后一行）：

Sub test()
    Dim values() As Double
    ReDim values(1 To 3)
    values(1) = 3.5
    values(2) = 5
    values(3) = 4.8

    Dim aggregate_fn As String
    aggregate_fn = "SUM"       

    Dim result As Double
    result = Evaluate("=" & aggregate_fn & "(" & values & ")")  ' <-- This doesn't work, but hopefully it's clear what it should do

End Sub

修改

我的原始代码也是使用values作为小数点的电子表格动态创建,数组。这导致Scott的答案出现问题。

Const datasht = "Daten"
Const aggregate_cell = "G1"

Sub run()
    Dim sht As Worksheet
    Dim n_rows As Integer
    Dim rw As Integer

    Application.DecimalSeparator = "."

    Set sht = ActiveWorkbook.Worksheets(datasht)
    n_rows = sht.Cells(1, 1).CurrentRegion.Rows.Count  ' Get range of data

    Dim values() As String
    ReDim values(1 To n_rows)

    For rw = 1 To n_rows
        values(rw) = sht.Cells(rw, 1).Value
    Next rw
    Debug.Print (aggregate(values))

End Sub

Function aggregate(values() As String)
    ' Get aggregated value
    Dim aggregate_fn As String
    aggregate_fn = ActiveWorkbook.Worksheets(datasht).Range(aggregate_cell).Value
    aggregate = Evaluate("=" & aggregate_fn & "(" & Join(values, ",") & ")") ' <-- doesn't work as intended

End Function

Answer 1

这适用于通过Application.WorksheetFunction提供的任何功能，如果传递的值太多，则不太可能发生错误。

Sub Tester()

    Dim arr(0 To 1000), res, x As Long, f as String

    'get some values to work with...
    For x = 0 To 1000
        arr(x) = Rnd() * 10
    Next x

    f = "SUM"

    res = CallByName(Application.WorksheetFunction, f, VbMethod, arr)

    Debug.Print res

End Sub

Answer 2

我能够通过从您的数组创建一个字符串，然后使用它来实现这一点：

Sub test()

    Dim values() As Double
    ReDim values(1 To 3)
    values(1) = 3.5
    values(2) = 5
    values(3) = 4.8

    Dim mystring As String, i As Long
    mystring = values(LBound(values))

    For i = LBound(values) + 1 To UBound(values)
        mystring = mystring & "," & values(i)
    Next i

    Dim aggregate_fn As String
    aggregate_fn = "SUM"

    Dim result As Double
    result = Evaluate("=" & aggregate_fn & "(" & mystring & ")")

    Debug.Print result

End Sub

Answer 3

Join使用Strings将值更改为String而不是Double：

Sub test()
    Dim values() As String
    ReDim values(1 To 3)
    values(1) = 3.5
    values(2) = 5
    values(3) = 4.8

    Dim aggregate_fn As String
    aggregate_fn = "SUM"

    Dim result As Double
    result = Evaluate("=" & aggregate_fn & "(" & Join(values, ",") & ")")
    Debug.Print result
End Sub

根据您的编辑，根本不需要数组，只需将范围和工作表传递给函数，并在范围内使用.Address。

Const datasht = "Daten"
Const aggregate_cell = "G1"

Sub run()
    Dim sht As Worksheet
    Dim n_rows As Integer
    Dim rw As Integer

    'Application.DecimalSeparator = "."

    Set sht = ActiveWorkbook.Worksheets(datasht)
    n_rows = sht.Cells(1, 1).CurrentRegion.Rows.Count  ' Get range of data

    Dim rng As Range
    Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(n_rows, 1))

    Debug.Print (aggregate(sht, rng))

End Sub

Function aggregate(sht As Worksheet, rng As Range)
    ' Get aggregated value
    Dim aggregate_fn As String
    aggregate_fn = sht.Range(aggregate_cell).Value
    aggregate = sht.Evaluate("=" & aggregate_fn & "(" & rng.Address(1, 1) & ")") 
End Function

在数组值上应用动态定义的聚合函数

3 个答案: