Function kicCeiling(ByVal vNum As Variant, ByVal vSig As Variant) As Variant
Dim vRes
Dim r&, c&
Dim n&, nrL&, nrU&, ncL&, ncU&
Dim s&, srL&, srU&, scL&, scU&
On Error Resume Next
If TypeName(vNum) = "Range" Then vNum = vNum.Value
nrU = -1: ncU = -1
nrL = LBound(vNum, 1): nrU = UBound(vNum, 1)
ncL = LBound(vNum, 2): ncU = UBound(vNum, 2)
If ncU> -1 Then n = 2 Else If nrU> -1 Then n = 1 Else n = 0
If TypeName(vSig) = "Range" Then vSig = vSig.Value
srU = -1: scU = -1
srL = LBound(vSig, 1): srU = UBound(vSig, 1)
scL = LBound(vSig, 2): scU = UBound(vSig, 2)
If scU> -1 Then s = 2 Else If srU> -1 Then s = 1
Select Case n & s
Case "00"
vRes = GetCeiling(vNum, vSig)
Case "20"
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig): Next: Next
Case "02"
ReDim vRes(srL To srU, scL To scU)
For r = srL To srU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum, vSig(r, c)): Next: Next
Case "22"
Debug.Assert nrL = srL And ncL = scL
If nrU = srU And ncU = scU Then
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c)): Next: Next
ElseIf nrU = 1 Then
ReDim vRes(srL To srU, ncL To ncU)
For r = srL To srU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(1, c), vSig(r, 1)): Next: Next
ElseIf srU = 1 Then
ReDim vRes(nrL To nrU, scL To scU)
For r = nrL To nrU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(1, c)): Next: Next
Else
nrU = Application.Max(nrU, srU)
ncU = Application.Max(ncU, scU)
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU
If r <= UBound(vNum, 1) And r <= UBound(vSig, 1) Then
For c = ncL To ncU
If c <= UBound(vNum, 2) And c <= UBound(vSig, 2) Then
vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c))
Else
vRes(r, c) = CVErr(xlErrNA)
End If
Next
Else
For c = ncL To ncU
vRes(r, c) = CVErr(xlErrNA)
Next
End If
Next
End If
Case "10"
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig): Next
Case "01"
ReDim vRes(srL To srU)
For r = srL To srU: vRes(r) = GetCeiling(vNum, vSig(r)): Next
Case "11"
Debug.Assert nrL = srL And nrU = srU
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig(r)): Next
Case "21"
Debug.Assert ncU = 1
ReDim vRes(nrL To nrU, srL To srU)
For r = nrL To nrU: For c = srL To srU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(c)): Next: Next
Case "12"
Debug.Assert scU = 1
ReDim vRes(srL To srU, nrL To nrU)
For r = srL To srU: For c = nrL To nrU: vRes(r, c) = GetCeiling(vNum(c), vSig(r, 1)): Next: Next
End Select
kicCeiling = vRes
End Function
Private Function GetCeiling(ByVal number As Variant, ByVal significance As Variant) As Variant
Dim dNum#, dSig#, dTmp#
Dim vRes
On Error GoTo errH
Select Case VarType(number) '+vbArray will error out.
Case vbError: vRes = number: GoTo endH
Case vbBoolean: dNum = Abs(number)
Case Else: dNum = number
End Select
Select Case VarType(significance)
Case vbError: vRes = significance: GoTo endH
Case vbBoolean: dSig = Abs(significance)
Case Else: dSig = significance
End Select
If dNum = 0 Or dSig = 0 Then
vRes = 0#
ElseIf Sgn(dNum) <> Sgn(dSig) Then
vRes = CVErr(xlErrNum)
Else
dTmp = dNum / dSig
vRes = (Int(dTmp) + Abs(dTmp <> Int(dTmp))) * dSig
End If
endH:
GetCeiling = vRes
Exit Function
errH:
vRes = CVErr(xlErrValue)
GoTo endH:
End Function