关于不定参数（输入工作表区域）使用单元格循环时的问题

muse123456

求助各位大神，以下问题困扰了自己快两周了，查阅了大量资料，尝试了多种方法，都不可行！
问题：
目前的函数可以使用（不定参数部分可接受工作表区域），并计算出结果，但是很明显，循环表达式：
审计收费 = 审计收费 + 速算数1 + (单元格 - 1000000) * 基础费率2 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
......
在For-Next结构中，是被重复计算了的
尝试解决的方案：
1.通过确定单元格在工作表区域中的位置，并将其值赋值给一个新的数组，利用新数组修改上述计算过程
'                Set TempRange = Intersect(标的列表(i).Parent.UsedRange, 标的列表(i))
'                If 单元格.Address = Range(TempRange)(i).Address Then
'                    计费基础(i) = 单元格.Value
'                End If
结果：程序无法接受到参数，直接提示#VALUE！错误
2.尝试建立一个平减指数，来将循环中重复的部分抠出来，很遗憾，自己水平不够，建立不起来
3.尝试将不定参数修改为区域参数，将区域赋值给数组，很遗憾，也失败了，错误依然为#VALUE！

自定义函数过程如下，拜求各位大神帮小弟解决，不胜感激！

Function 审计收费(任期开始, 任期结束, 折扣, ParamArray 标的列表()) As Double
    Const 速算数1 = 5000 '定义累进费率的速算数常量，费率发生变化在此修改即可（适用于(100万元,500万元]的标的）
    Const 速算数2 = 11000 '（适用于(500万元,1000万元]的标的）
    Const 速算数3 = 15000 '（适用于(1000万元,5000万元]的标的）
    Const 速算数4 = 31000 '（适用于(5000万元,1亿元]的标的）
    Const 速算数5 = 46000 '（适用于(1亿元,5亿元]的标的）
    Const 速算数6 = 134000 '（适用于(5亿元,10亿元]的标的）
    Const 速算数7 = 209000 '（适用于(10亿元,100亿元]的标的）
    Const 速算数8 = 1109000 '（适用于(100亿元,+∞)的标的）
    Const 基础费率1 = 0.005 '定义基础收费费率常量，，费率发生变化在此修改即可（适用于[0,100万元]的标的）
    Const 基础费率2 = 0.0015 '（适用于(100万元,500万元]的标的）
    Const 基础费率3 = 0.0008 '（适用于(500万元,1000万元]的标的）
    Const 基础费率4 = 0.0004 '（适用于(1000万元,5000万元]的标的
    Const 基础费率5 = 0.0003 '（适用于(5000万元,1亿元]的标的）
    Const 基础费率6 = 0.00022 '（适用于(1亿元,5亿元]的标的）
    Const 基础费率7 = 0.00015 '（适用于(5亿元,10亿元]的标的）
    Const 基础费率8 = 0.0001 '（适用于(10亿元,100亿元]的标的
    Const 基础费率9 = 0.00006 '（适用于(100亿元,+∞)的标的
    Dim 任期年度 As Integer, 任期月份 As Integer
    Dim i As Integer, j As Integer '声明i、j为整数型变量（控制变量）
    Dim 基础收费(), 月份系数(), 年度系数(), 年度任期月份(), 计费基础(), 年度收费()
    Dim 单元格 As Range, TempRange As Range '声明单元格作为区域变量，使其可以处理1个连续区域的参数，即连续区域内的标的
    Dim 标的, a
    任期年度 = Year(任期结束) - Year(任期开始) + 1
    任期月份 = DateDiff("m", 任期开始, 任期结束) + 1 '将首末月份全部考虑进任期，故+1
    ReDim 基础收费(1 To 任期年度)
    ReDim 月份系数(1 To 任期年度)
    ReDim 年度系数(1 To 任期年度)
    ReDim 年度任期月份(1 To 任期年度)
    审计收费 = 0 '审计收费赋予初始值0，不赋值计算有误
    For Each 标的 In 标的列表
        For Each 单元格 In 标的
'   任期中小于等于3年的部分，按基础费率150%计收；大于3年的部分，按基础费率收费
            For i = 1 To 任期年度
                If i <= 3 Then '如果任期小于等于3年
                    年度系数(i) = 1.5 '任期3年以内按150%收费
                Else '其他情况（即任期大于3年的时候）
                    年度系数(i) = 1 '任期大于3年的部分按基础费率收费
                End If
'   年度任期的月份在一个季度以内的，按0.5计收；在二个季度以内的，按0.7计收；在三个季度以内的，按0.9计收
                If 任期年度 = 1 Then
                    年度任期月份(i) = 任期月份
                ElseIf 任期年度 >= 2 Then
                    If i = 1 Then
                        年度任期月份(i) = 12 - Month(任期开始) + 1 '任期开始当月计入任期
                    ElseIf i = 任期年度 Then
                        年度任期月份(i) = Month(任期结束)
                    Else
                        年度任期月份(i) = 12
                    End If
                End If
                Select Case 年度任期月份(i)
                    Case Is <= 3 '任期第一年月份小于等于3个月（一个季度内）
                        月份系数(i) = 0.5
                    Case 4 To 6 '任期第一年月份在4到6个月（半年内）
                        月份系数(i) = 0.7
                    Case 7 To 9 '任期第一年月份在7到9个月内（三个季度内）
                        月份系数(i) = 0.9
                    Case 10 To 12 '任期第一年月份在12个月内（一年）
                        月份系数(i) = 1
                End Select
'   本程序最低收费2000，既不考虑打折，也不考虑按系数加倍
'                Set TempRange = Intersect(标的列表(i).Parent.UsedRange, 标的列表(i))
'                If 单元格.Address = Range(TempRange)(i).Address Then
'                    计费基础(i) = 单元格.Value
'                End If
                If 单元格 = "" Or 单元格 = "0" Then '如果标的为0或为空
                    审计收费 = 审计收费 + 0
                Else
                    Select Case 单元格 '以标的值为判断条件
'                        Case Is <= 400000 * 2 / 3 '如果收入或资产小于80万/3（此时不考虑折扣前的审计收费小于等于2000）
'                            审计收费 = 审计收费 + 2000  '最低收费2000不考虑打折
                        Case Is <= 1000000  '如果标的小于100万（To在表示范围时，双侧包含，左侧加0.0001以处理
                            If 单元格 * 基础费率1 * 月份系数(i) * 年度系数(i) < 2000 Then
                                审计收费 = 审计收费 + 2000
                            Else
                                审计收费 = 审计收费 + 单元格 * 基础费率1 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                            End If
                        Case 1000000.0001 To 5000000
                            审计收费 = 审计收费 + 速算数1 + (单元格 - 1000000) * 基础费率2 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 5000000.0001 To 10000000
                            审计收费 = 审计收费 + 速算数2 + (单元格 - 5000000) * 基础费率3 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 10000000.0001 To 50000000
                            审计收费 = 审计收费 + 速算数3 + (单元格 - 10000000) * 基础费率4 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 50000000.0001 To 100000000
                            审计收费 = 审计收费 + 速算数4 + (单元格 - 50000000) * 基础费率5 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 100000000.0001 To 500000000
                            审计收费 = 审计收费 + 速算数5 + (单元格 - 100000000) * 基础费率6 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 500000000.0001 To 1000000000
                            审计收费 = 审计收费 + 速算数6 + (单元格 - 500000000) * 基础费率7 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 1000000000.0001 To 10000000000# ' #为程序自动添加的数值标识，代表双精度型
                            审计收费 = 审计收费 + 速算数7 + (单元格 - 1000000000) * 基础费率8 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case Else '其他情况（大于100亿的时候）
                            审计收费 = 审计收费 + 速算数8 + (单元格 - 10000000000#) * 基础费率9 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                    End Select
                End If
            Next i
        Next 单元格
    Next 标的
'    For j = 1 To 任期年度
'        审计收费 = 审计收费/?平减指数 '
'    Next j
    If 任期月份 <= 12 Then '如果任期总时间未超过1年
        MsgBox "任期未超1年。若为中期审计，勿需办理；若为离任审计，可以离任交接代替审计。" '提示前述语句
    End If '结束If语句
    If 审计收费 = 0 Then
        MsgBox "标的为0，或未输入标的数据，请输入！" '提示前述语句
    End If '结束If语句
End Function

muse123456

补充说明：
本程序想实现的目标，按照年度标的的值（根据基础费率计算得到基础收费），在基础收费基础上，根据总任期年度和年度任期月份来修正当年的收费，在此基础上进行累加，折扣是对总体的，年度最低收费2000元，不得低于，不参与折扣，参见附件图片。图片中2632562.79和11500都是正确的值（使用Sub过程得到），11765042.74是根据2632562.79对应的数据计算得到的结果，很明显远远大于正确值。

muse123456

没有大神来解惑吗，我都两周睡不着了，555！！！

muse123456

又想了一周，结合到昨天分享的按填充颜色处理不连续区域的心得，结果自己搞定了，关键还是使用了一个不参与For-Next循环的控制变量，或者说计步器，具体修改结果如下：
Function 审计收费(任期开始, 任期结束, 折扣, ParamArray 标的列表()) As Double '"任期开始, 任期结束, 折扣,标的()"作为参数，不在Function中单独声明，但要在Sub过程中声明
    Application.Volatile  '设置为易失性函数
    Const 速算数1 = 5000 '定义累进费率的速算数常量，费率发生变化在此修改即可（适用于(100万元,500万元]的标的）
    Const 速算数2 = 11000 '（适用于(500万元,1000万元]的标的）
    Const 速算数3 = 15000 '（适用于(1000万元,5000万元]的标的）
    Const 速算数4 = 31000 '（适用于(5000万元,1亿元]的标的）
    Const 速算数5 = 46000 '（适用于(1亿元,5亿元]的标的）
    Const 速算数6 = 134000 '（适用于(5亿元,10亿元]的标的）
    Const 速算数7 = 209000 '（适用于(10亿元,100亿元]的标的）
    Const 速算数8 = 1109000 '（适用于(100亿元,+∞)的标的）
    Const 基础费率1 = 0.005 '定义基础收费费率常量，，费率发生变化在此修改即可（适用于[0,100万元]的标的）
    Const 基础费率2 = 0.0015 '（适用于(100万元,500万元]的标的）
    Const 基础费率3 = 0.0008 '（适用于(500万元,1000万元]的标的）
    Const 基础费率4 = 0.0004 '（适用于(1000万元,5000万元]的标的
    Const 基础费率5 = 0.0003 '（适用于(5000万元,1亿元]的标的）
    Const 基础费率6 = 0.00022 '（适用于(1亿元,5亿元]的标的）
    Const 基础费率7 = 0.00015 '（适用于(5亿元,10亿元]的标的）
    Const 基础费率8 = 0.0001 '（适用于(10亿元,100亿元]的标的
    Const 基础费率9 = 0.00006 '（适用于(100亿元,+∞)的标的
    Dim 任期年度 As Integer, 任期月份 As Integer
    Dim i As Integer '声明i为整数型变量（控制变量）
    Dim 基础收费(), 月份系数(), 年度系数(), 年度任期月份()
    Dim 单元格 As Range, 标的 As Variant '声明单元格作为区域变量，使其可以处理1个连续区域的参数，即连续区域内的标的，而标的必须是变体型的
    任期年度 = Year(任期结束) - Year(任期开始) + 1
    任期月份 = DateDiff("m", 任期开始, 任期结束) + 1 '将首末月份全部考虑进任期，故+1
    ReDim 基础收费(1 To 任期年度)
    ReDim 月份系数(1 To 任期年度)
    ReDim 年度系数(1 To 任期年度)
    ReDim 年度任期月份(1 To 任期年度)
    审计收费 = 0 '审计收费赋予初始值0，不赋值计算有误
    i = 1
    For Each 标的 In 标的列表
        For Each 单元格 In 标的
'   任期中小于等于3年的部分，按基础费率150%计收；大于3年的部分，按基础费率收费
                If i <= 3 Then '如果任期小于等于3年
                    年度系数(i) = 1.5 '任期3年以内按150%收费
                Else '其他情况（即任期大于3年的时候）
                    年度系数(i) = 1 '任期大于3年的部分按基础费率收费
                End If
'   年度任期的月份在一个季度以内的，按0.5计收；在二个季度以内的，按0.7计收；在三个季度以内的，按0.9计收
                If 任期年度 = 1 Then
                    年度任期月份(i) = 任期月份
                ElseIf 任期年度 >= 2 Then
                    If i = 1 Then
                        年度任期月份(i) = 12 - Month(任期开始) + 1 '任期开始当月计入任期
                    ElseIf i = 任期年度 Then
                        年度任期月份(i) = Month(任期结束)
                    Else
                        年度任期月份(i) = 12
                    End If
                End If
                Select Case 年度任期月份(i)
                    Case Is <= 3 '任期第一年月份小于等于3个月（一个季度内）
                        月份系数(i) = 0.5
                    Case 4 To 6 '任期第一年月份在4到6个月（半年内）
                        月份系数(i) = 0.7
                    Case 7 To 9 '任期第一年月份在7到9个月内（三个季度内）
                        月份系数(i) = 0.9
                    Case 10 To 12 '任期第一年月份在12个月内（一年）
                        月份系数(i) = 1
                End Select
'   本程序最低收费2000，既不考虑打折，也不考虑按系数加倍
                If 单元格 = "" Or 单元格 = "0" Then '如果标的为0或为空
                    审计收费 = 审计收费 + 0
                Else
                    Select Case 单元格 '以标的值为判断条件
                        Case Is <= 1000000  '如果标的小于100万（To在表示范围时，双侧包含，左侧加0.0001以处理
                            If 单元格 * 基础费率1 * 月份系数(i) * 年度系数(i) * (1 - 折扣) < 2000 Then
                                审计收费 = 审计收费 + 2000
                            Else
                                审计收费 = 审计收费 + 单元格 * 基础费率1 * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                            End If
                        Case 1000000.0001 To 5000000
                            审计收费 = 审计收费 + (速算数1 + (单元格 - 1000000) * 基础费率2) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 5000000.0001 To 10000000
                            审计收费 = 审计收费 + (速算数2 + (单元格 - 5000000) * 基础费率3) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 10000000.0001 To 50000000
                            审计收费 = 审计收费 + (速算数3 + (单元格 - 10000000) * 基础费率4) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 50000000.0001 To 100000000
                            审计收费 = 审计收费 + (速算数4 + (单元格 - 50000000) * 基础费率5) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 100000000.0001 To 500000000
                            审计收费 = 审计收费 + (速算数5 + (单元格 - 100000000) * 基础费率6) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 500000000.0001 To 1000000000
                            审计收费 = 审计收费 + (速算数6 + (单元格 - 500000000) * 基础费率7) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case 1000000000.0001 To 10000000000# ' #为程序自动添加的数值标识，代表双精度型
                            审计收费 = 审计收费 + (速算数7 + (单元格 - 1000000000) * 基础费率8) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                        Case Else '其他情况（大于100亿的时候）
                            审计收费 = 审计收费 + (速算数8 + (单元格 - 10000000000#) * 基础费率9) * 月份系数(i) * 年度系数(i) * (1 - 折扣)
                    End Select
                End If
            i = i + 1 '计步器
        Next 单元格
    Next 标的
    If 任期月份 <= 12 Then '如果任期总时间未超过1年
        MsgBox "任期未超1年。若为中期审计，勿需办理；若为离任审计，可以离任交接代替审计。" '提示前述语句
    End If '结束If语句
    If 审计收费 = 0 Then
        MsgBox "标的为0，或未输入标的数据，请输入！" '提示前述语句
    End If '结束If语句
End Function

终于睡得着了！