用户定义的函数，它接受 Excel VBA 中的连续和不连续范围

Posted 2023-04-13

技术标签:

【中文标题】用户定义的函数，它接受 Excel VBA 中的连续和不连续范围【英文标题】：User defined function which accepts both continuous and discontinuous ranges in Excel VBA 【发布时间】：2016-11-11 13:50:00 【问题描述】：

基础问题

我正在尝试在 Excel 中创建自己的 VBA 函数，我希望它能够接受基本上任何类型的输入并将输入视为向量，但我还没有弄清楚如何为这两者连续（例如 (A1:A10) 或 (A1:R1)）和不连续（例如 (A1;B5;G12)）范围。我可以使这些功能适用于任何一种，但不能同时适用于两种类型。

我希望这样做的原因是我希望制作自己的 AVERAGE 和 STDEV.S 版本，它可以处理单元格中的 #N/A 值。我知道我可以使用 AVERAGEIF(range;"#N/A") 来计算平均值，但是 AVERAGEIF 不允许我使用不连续的范围，据我所知，没有这样的选择对于 STDEV.S.

我的数据背景

我的数据是从我用各种化学方法测量的几个样品中获得的。我每天准备一个样品，然后用一天的剩余时间来测量它。每个样品都被认为是“一个实验”，每个实验都存储为单独的工作表，我在其中存储来自所有不同分析方法的数据并进行任何数据处理以使数据具有可比性（例如，从摩尔浓度计算摩尔浓度，对温度差异进行调整等);我还存储了很多半不相关的信息（例如最终结果不需要的注释，但仍然需要保留）。长话短说，将所有运行都存储在一个工作表中的数据太多了，因为这会使查看起来太混乱，处理单个实验也太混乱，尤其是当我在一堆数据中添加新实验时；我目前的方法允许我简单地复制现有工作表并将新数据粘贴到旧方程中。然后将处理后的数据链接到“概述”工作表，在该工作表中我列出了最有趣的数据结构，以便我可以轻松地比较来自不同测量的值。链接是通过 INDIRECT 完成的，因此我可以轻松地从新实验中添加新信息。由于数据来自实验，因此必然会有数据丢失，我使用#N/A 来覆盖这样的漏洞，例如从一个工作表链接到另一个工作表会在数据丢失时产生“0”。我知道我可以用简单的破折号 (-) 或类似的东西替换 #N/A，这将使内置的 AVERAGE 和 STDEV.S 工作，但我想使用相同的数据数组进行绘图，它显示为如果只有 #N/A 将从图中删除数据点，因为 excel 中的图形将破折号视为零值。

我的“概览”工作表上的数据排列为

    Date    pH    Na+ conc    K+ conc  ...lots of other variables
    Date 1  7.4     140        3       ... 
    Date 2  7.1     #N/A       4       ...
    ....    ...     ...        ...     ...
    Date N  7.3     143        3.5     ...

适用于连续范围的代码

到目前为止，我已经设法做的，它支持连续范围，是以下代码示例，它计算包含 #N/A 值的单元格的标准偏差。当我选择一整列（或一列的连续部分）时，此代码可以完美运行，但如果我选择不连续的单元格范围，则不会。

Function StdevNaN_S(xRange)

'Sample Standard deviation which excludes NaN values

xR = xRange 'I can, for some strange reason, not use UBound unless I re-store the data in xR...
NoE1 = UBound(xR, 1) 'Number of Elements along dimension 1 (columns)
NoE2 = UBound(xR, 2) 'Number of Elements along dimension 2 (rows)
NoE = NoE1 * NoE2 'Total Number of Elements (this way makes it work regardless of row or column range)

'Need to first calculate the NaN excluded average value - could use the AVERAGEIF to simplify, but that will break if the range is discontinuous
xSum = 0
xAmount = 0
For N = 1 To NoE
    If IsNumeric(xRange(N)) Then
        xSum = xSum + xRange(N)
        xAmount = xAmount + 1 'counting how many cells that are used in the sum, used as the divisor in the average and the variance expression. Couldn't use the "CountIf" expression as it counted cells which contained text
    Else
    End If
Next N
xAvg = xSum / xAmount

'Uses the average in the variance calculation
xSum = 0
For N = 1 To NoE
    If IsNumeric(xRange(N)) Then
        xSum = xSum + (xRange(N) - xAvg) ^ 2 'Summing up (x - x_avg) ^ 2, which is the dividend of the variance expression
    Else
    End If
Next N

StdevNaN_S = (xSum / (xAmount - 1)) ^ 0.5 'the sample standard deviation is the square root of the corrected variance

End Function

我的问题是我希望对部分数据进行平均值和标准差计算。例如，日期 1、5、19 和 34 生产的样品是用特定的化学品库存生产的，而日期 2:4、6:11 和 25:33 则来自第二个库存，其余的来自第三个库存，所以我想知道具体股票是否有任何影响。

适用于不连续范围的代码

我在cpaerson.com 上找到了一个示例，该示例展示了如何允许函数采用不连续范围并将其视为向量。他们的例子是

Function SumOf(ParamArray Nums() As Variant) As Variant
''''''''''''''''''''''''''''''''''
' Add up the numbers in Nums
''''''''''''''''''''''''''''''''''
    Dim N As Long
    Dim D As Double
    For N = LBound(Nums) To UBound(Nums)
        If IsNumeric(Nums(N)) = True Then
            D = D + Nums(N)
        Else
            SumOf = CVErr(xlErrNum)
            Exit Function
        End If
    Next N
    SumOf = D
End Function

但是，此功能仅适用于不连续的选择 - 如果我选择例如 (A1;A5;A19;A34) 或 (A1;A2;A3;.. .;A34) 但如果我选择 (A1:A34) 则会出现错误。

问题

我应该如何编码我的函数，以便我可以选择我想要的任何单元格，然后使用它们的内容进行计算？

【问题讨论】：

不是一个完整的答案，但请查看范围的 Areas 属性并在您的函数中构建一个检查以计算区域数。如果为 1，则按下，如果 >1 循环遍历每个区域并组合成一个数组。可能有点小题大做，这里的一些聪明人可能有一个好主意。您还可以将连续和不连续范围的范围作为字符串传递给 UDF，然后自己将字符串解析为 ;（您的区域设置似乎就是这种情况）和 @987654327 @. 感谢您的 cmets - 你们（@SJR 和 @ Ralph）所描述的正是我想做的。我的问题仍然是我在 VBA 方面不够熟练，无法实际为其编写代码：/ 看看这个早先的问题，看看它是否能说明问题***.com/questions/25365547/… @SJR 谢谢你的提示 【参考方案1】：

我终于设法弄清楚如何对数据进行排序，以便该函数可以处理连续和不连续范围，这非常感谢来自 SJR 和 Ralph 以及来自 answer on this question 的问题的 cmets。

允许不连续范围的方法是使用 ParamArray，然后检查输入的所有参数并检查它们包含的内容（这是我最初失败的地方，因为我不知道如何让 Excel 检查我输入的每个参数的内容到函数）。棘手的部分是，如果它当前检查的参数仅包含一个单元格，那么与包含连续范围的情况相比，它需要处理的方式是不同的。

例如，如果对仅包含一个单元格的参数使用 UBound，则检查 ParamArray 中的所有参数将失败。此外，为了正确寻址参数中连续范围内的每个单元格，需要循环通过 InputParameters(i).Cells(j)，而如果参数只是单个单元格，则对其进行寻址就足够了作为 InputParameters(i)。

我现在生成的代码可以按我的意愿工作；我可以选择任何范围的单元格并计算标准偏差和平均值，同时排除 NaN 值。我将它与内置的 STDEV.S、STDEV.P 和 AVERAGE 进行了比较，它产生了完全相同的结果*。我不知道为什么内置函数默认不排除 NaN 值，但我为任何想要使用它的人提供了以下函数的代码。

不包括 NaN 值的 STDEV.S 代码

Function NaNStdev_S(ParamArray xRange() As Variant) As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'A function to calculate the sample standard deviation of any ranges of cells
'while excluding text, logicals, empty cells and cells containing #N/A.
'Can handle both continuous and discontinuous ranges.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim CellsUsed As Integer
Dim NumArg As Integer
Dim NumCell As Integer
Dim xAvg As Double
Dim xSum As Double
Dim xTemp As Variant
Dim xVect() As String

NumArg = UBound(xRange) 'Counts the number of input arguments (i.e., number of discontinuous regions)

For i = 0 To NumArg 'Goes through each discontinuous region
    xTemp = xRange(i) 'Stores the current region in a temporary variable as several of the later operations cannot be performed on the full input array
    If IsArray(xTemp) Then 'Checks if the current region is an array; if yes, then that array will be continuous
        NumCell = UBound(xTemp, 1) * UBound(xTemp, 2) 'Checks how many cells are in the array
            For j = 1 To NumCell 'Goes through all cells in the current region
                If IsEmpty(xRange(i).Cells(j)) Then 'do nothing
                ElseIf Application.IsLogical(xRange(i).Cells(j)) Then 'do nothing
                ElseIf IsNumeric(xRange(i).Cells(j)) Then 'If the content of the cell is numeric, then use it
                    xSum = xSum + xRange(i).Cells(j) 'Add the current cell value to the sum of all cell values
                    CellsUsed = CellsUsed + 1 'Counts how many of the cell values that are actually used
                    ReDim Preserve xVect(CellsUsed) 'Adjusts the size of xVect
                    xVect(CellsUsed) = xRange(i).Cells(j) 'Reformats all usable values into one single vector for later use
                Else
                End If
            Next j
    Else 'If the current region is not an array, then it's just a single value
        If IsEmpty(xRange(i)) Then 'do nothing
        ElseIf IsNumeric(xRange(i)) Then 'If the content of the current region is numeric, then use it
            xSum = xSum + xRange(i) 'Add the current cell (region) value to the sum of all cell values
            CellsUsed = CellsUsed + 1 'Increase the counter of used values
            ReDim Preserve xVect(CellsUsed) 'Adjusts the size of xVect
            xVect(CellsUsed) = xRange(i) 'Adds the current value into the reformatted vector for later use
        Else
        End If
    End If
Next i

xAvg = xSum / CellsUsed 'Average of all cells which contains numbers

xSum = 0 'resets the sum as it's no longer needed
For i = 1 To CellsUsed 'Goes through the reformatted vector and calculates the sum of (x - x_avg) ^ 2
    xSum = xSum + (xVect(i) - xAvg) ^ 2 'This is the dividend of the variance equation
Next i

NaNStdev_S = (xSum / (CellsUsed - 1)) ^ 0.5 'the sample standard deviation is the square root of the corrected variance

End Function

不包括 NaN 值的 STDEV.P 代码

Function NaNStdev_P(ParamArray xRange() As Variant) As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'A function to calculate the population standard deviation of any ranges of cells
'while excluding text, logicals, empty cells and cells containing #N/A.
'Can handle both continuous and discontinuous ranges.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim CellsUsed As Integer
Dim NumArg As Integer
Dim NumCell As Integer
Dim xAvg As Double
Dim xSum As Double
Dim xTemp As Variant
Dim xVect() As String

NumArg = UBound(xRange) 'Counts the number of input arguments (i.e., number of discontinuous regions)

For i = 0 To NumArg 'Goes through each discontinuous region
    xTemp = xRange(i) 'Stores the current region in a temporary variable as several of the later operations cannot be performed on the full input array
    If IsArray(xTemp) Then 'Checks if the current region is an array; if yes, then that array will be continuous
        NumCell = UBound(xTemp, 1) * UBound(xTemp, 2) 'Checks how many cells are in the array
            For j = 1 To NumCell 'Goes through all cells in the current region
                If IsEmpty(xRange(i).Cells(j)) Then 'do nothing
                ElseIf Application.IsLogical(xRange(i).Cells(j)) Then 'do nothing
                ElseIf IsNumeric(xRange(i).Cells(j)) Then 'If the content of the cell is numeric, then use it
                    xSum = xSum + xRange(i).Cells(j) 'Add the current cell value to the sum of all cell values
                    CellsUsed = CellsUsed + 1 'Counts how many of the cell values that are actually used
                    ReDim Preserve xVect(CellsUsed) 'Adjusts the size of xVect
                    xVect(CellsUsed) = xRange(i).Cells(j) 'Reformats all usable values into one single vector for later use
                Else
                End If
            Next j
    Else 'If the current region is not an array, then it's just a single value
        If IsEmpty(xRange(i)) Then 'do nothing
        ElseIf IsNumeric(xRange(i)) Then 'If the content of the current region is numeric, then use it
            xSum = xSum + xRange(i) 'Add the current cell (region) value to the sum of all cell values
            CellsUsed = CellsUsed + 1 'Increase the counter of used values
            ReDim Preserve xVect(CellsUsed) 'Adjusts the size of xVect
            xVect(CellsUsed) = xRange(i) 'Adds the current value into the reformatted vector for later use
        Else
        End If
    End If
Next i

xAvg = xSum / CellsUsed 'Average of all cells which contains numbers

xSum = 0 'resets the sum as it's no longer needed
For i = 1 To CellsUsed 'Goes through the reformatted vector and calculates the sum of (x - x_avg) ^ 2
    xSum = xSum + (xVect(i) - xAvg) ^ 2 'This is the dividend of the variance equation
Next i

NaNStdev_P = (xSum / CellsUsed) ^ 0.5  'the population standard deviation is the square root of the variance

End Function

不包括 NaN 值的 AVERAGE 代码

Function NaNAverage(ParamArray xRange() As Variant) As Double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'A function to calculate the average of any ranges of cells
'while excluding text, logicals, empty cells and cells containing #N/A.
'Can handle both continuous and discontinuous ranges.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim CellsUsed As Integer
Dim NumArg As Integer
Dim NumCell As Integer
Dim xSum As Double
Dim xTemp As Variant

NumArg = UBound(xRange) 'Counts the number of input arguments (i.e., number of discontinuous regions)

For i = 0 To NumArg 'Goes through each discontinuous region
    xTemp = xRange(i) 'Stores the current region in a temporary variable as several of the later operations cannot be performed on the full input array
    If IsArray(xTemp) Then 'Checks if the current region is an array; if yes, then that array will be continuous
        NumCell = UBound(xTemp, 1) * UBound(xTemp, 2) 'Checks how many cells are in the array
            For j = 1 To NumCell 'Goes through all cells in the current region
                If IsEmpty(xRange(i).Cells(j)) Then 'do nothing
                ElseIf Application.IsLogical(xRange(i).Cells(j)) Then 'do nothing
                ElseIf IsNumeric(xRange(i).Cells(j)) Then 'If the content of the cell is numeric, then use it
                    xSum = xSum + xRange(i).Cells(j) 'Add the current cell value to the sum of all cell values
                    CellsUsed = CellsUsed + 1 'Counts how many of the cell values that are actually used
                Else
                End If
            Next j
    Else 'If the current region is not an array, then it's just a single value
        If IsEmpty(xRange(i)) Then 'do nothing
        ElseIf IsNumeric(xRange(i)) Then 'If the content of the current region is numeric, then use it
            xSum = xSum + xRange(i) 'Add the current cell (region) value to the sum of all cell values
            CellsUsed = CellsUsed + 1 'Increase the counter of used values
        Else
        End If
    End If
Next i

NaNAverage = xSum / CellsUsed 'Average of all cells which contains numbers

End Function

*免责声明

我提到代码产生的值与内置函数完全相同 - 但是，我确实注意到有一次它没有。我将以下随机选择的值作为随机大小和定位的范围放置在我的 Excel 工作表中：

(00:01:00, -10, -33, 10, 33, 20, 66, 30, 40, 300, TRUE, empty cell , #N/A)

如果它们是随机分布的（即，我将它们放在以下单元格中 (P22:Q23;R22:R23;S22:T22;S21:V21;Q28)），那么它们与 STDEV.S 产生的值不同（我已经从 STDEV.S 函数中手动排除了带有 #N/A 的单元格），但它们仅在小数点后 13 位不同（我的函数给出 93.5950714912684，而 STDEV.S 给出 93.5950714912683），这应该是一个足够小的错误无关紧要。有趣的是，如果我将所有值放在一行中（即，我将所有值放在例如 (M34:Y34) 上），那么我的函数和内置函数都会给出完全相同的结果（即 93.5950714912683） .错误似乎源于包含 1 分钟的单元格；如果我将 00:01:00 更改为任何其他时间值（例如 00:01:01 或 01:01:00），那么无论这些值是放在一行上还是随机分布，这两个函数都会产生完全相同的结果工作表上的区域。

我无法解释这种奇怪的行为，但到目前为止它似乎只产生了一个微不足道的错误，所以我会假设我的代码按预期工作。

【讨论】：

以上是关于用户定义的函数，它接受 Excel VBA 中的连续和不连续范围的主要内容，如果未能解决你的问题，请参考以下文章

Excel VBA - 条件格式中的用户定义函数

EXCEL 的自定义 VBA 函数中的用户定义警告

我在 excel VBA 中有一个函数，它使用文本框从用户那里获取输入

Excel VBA中的ThisCell属性如何使用？

通过用户定义的函数VBA缩短excel公式

Excel VBA - 用户定义函数 - 可变大小参数