Excel VBA解读（145）： MaxMinFair资源分配——一个数组UDF示例

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) <Demands(j, 1) Then
                    dAllocated(j, 1) =dAllocated(j, 1) + dAlloc
                End If
            Next j
  '为下一次迭代收集过剩的供应
           For j = 1 To nRows
                If dAllocated(j, 1) >=Demands(j, 1) Then
    '移除并累积多余的供应
                    dAvailable = dAvailable +dAllocated(j, 1) - Demands(j, 1)
                    dAllocated(j, 1) =Demands(j, 1)
                Else
    '统计未满足的需求
                    nUnsat = nUnsat + 1
                End If
            Next j
     '如果所有供应已分配或者所有需求都满足则结束
            If nUnsat = 0 Or dAvailable = 0#Then Exit Do
        Loop
Finish:
       '返回结果数组
        MaxMinFair = dAllocated
   End If
FuncFail:
End Function