学习Excel技术，关注微信公众号：
excelperfect
本文主要介绍使用VBA自定义函数（UDF）实现一个名叫MaxMinFair的有趣的算法。
这个算法的基本思想是在许多需求之间公平地共享供给资源，而不会让贪婪的需求占用过多的资源。该算法首先在需求之间平均分配供给，然后任何多余的供给（供给>需求）在尚未满足的需求之间平均分配，接着继续重新分配多余的供给，直到满足所有要求或者没有多余的供给来重新分配。
实现MaxMinFair
MaxMinFair是编写数组公式UDF的一个很好的例子。它有2个参数：Supply（单个数字）和Demands（一组数字，通常是一个Range对象）。
为了简单起见，Supply必须是单个数字>=0.0，并且Demands必须是单列垂直单元格区域或者数字数组。
该函数的参数声明为变体，以便用户可以提供单元格区域或者常量数组或返回数字数组的计算表达式。
该函数声明为返回变体。这允许函数返回错误值，或者单个数字或数字数组。
该函数首先设置错误处理并将单元格区域强制转换为值。
该函数的结果放置在一个动态调整大小的数组中，以匹配需求的数量。
该函数的核心是Do循环：
- 通过将可用供应除以未满足需求的数量来计算分配
- 将分配添加到每个未满足的需求中
- 在下一次循环迭代中收集任何多余的分配作为可用的供应
- 计算未满足的要求
当没有未满足的需求或者没有可用的供应要分配时，DO循环终止。
该函数将最后的结果数组（dAllocated（））赋值给variant类型函数。
VBA代码
下面是该函数的VBA代码：
Option Base 1
Function MaxMinFair(Supply AsVariant, Demands As Variant) As Variant
'数组函数,用于公平分配供给需求
'Supply必须是>=0.0的标量数字
'Demands必须是标量数字或者单个列区域或数据数组
Dim nUnsat As Long '未满足的需求数
Dim dAlloc As Double '分配给每个未满足的需求的数量
Dim dAllocated() As Double '分配给每个需求的数量数组
Dim nRows As Long '在Demands中的行数
Dim nCols As Long '在Demands中的列数
Dim dAvailable As Double '本次循环迭代可用的供给
Dim j As Long
'设置错误处理
On Error GoTo FuncFail
'如果错误则返回#Value
MaxMinFair = CVErr(xlErrValue)
'两个参数都必须包含数据
If IsEmpty(Supply) Or IsEmpty(Demands) Then GoTo FuncFail
'将单元格区域转换为值
If IsObject(Demands) Then Demands = Demands.Value2
If IsObject(Supply) Then Supply = Supply.Value2
'Supply必须是一个>=0的标量数
If IsArray(Supply) Then GoTo FuncFail
If Supply < 0# Then GoTo FuncFail
dAvailable = CDbl(Supply)
If Not IsArray(Demands) Then
'标量需求:供求最小化
If Demands < Supply Then
MaxMinFair = Demands
Else
MaxMinFair = Supply
End If
Else
'Demands必须是单个列数组
nRows = UBound(Demands, 1)
nCols = UBound(Demands, 2)
If nCols > 1 Then GoTo FuncFail
'设置输出数组
ReDim dAllocated(1 To nRows, 1 TonCols)
'统计未满足的需求
For j = 1 To nRows
'如果不是数字触发的错误
If dAllocated(j, 1) CDbl(Demands(j, 1)) Then nUnsat = nUnsat + 1
Next j
If nUnsat = 0 Then GoTo Finish
'循环迭代分配可用的供应给未满足的需求
Do
'分配给每个未满足的需求的数量
dAlloc = CDbl(dAvailable) / nUnsat
nUnsat = 0
dAvailable = 0#
'给未满足的需求平等分配可用的供应
For j = 1 To nRows
If dAllocated(j, 1) |
|
转播
