开源---自己的第一个VBA程序

最新推荐文章于 2025-03-28 09:17:51 发布

原创最新推荐文章于 2025-03-28 09:17:51 发布 · 1.6k 阅读

3 ·

CC 4.0 BY-SA版权

文章标签：

#vba #fun #function #basic #存储 #c

Office办公同时被 2 个专栏收录

23 篇文章

订阅专栏

VB & VBA

16 篇文章

订阅专栏

本文介绍了一款付款协议计算程序，该程序通过嵌套循环处理计算明细表与付款协议表，实现不同付款类型的利息计算。文章详细展示了核心函数的逻辑流程，包括付款天数计算、利率查找及各种支付公式的应用。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

'==============================付款协议表计算程序================================= '故障说明： '1. "001错误！！...无相应匹配公式..请查看表格！" ' -----说明有返利、付款天数为T或U 但没有付款所依据的公式类型 ' -----或者付款商品类型为所有、付款天数为T或U 但没有付款所依据的公式类型 '2. "002错误！！--请核对相应行数据是否存在返利率！！" '3. "003错误！！--利率值出错！！--请核对相应行数据是否存在返利率！！" '4. "004错误！！--利率计算超出合法范围！！--只针对0-90天--请核对表格数据！！" '5. "005错误！！无对应返利！！" '6 --其它未定义类型---可能属程序逻辑错误---待测试....... '================================================================================= Option Explicit '强制声明变量，使程序更严谨可靠 Public location As Long '此全局变量用于在子函数查询利率中定位区间 Private Declare Function timeGetTime Lib "winmm.dll" () As Long Dim lngStartTime As Long '定义时间暂存变量 '***************************************主程序开始************************************************** Sub 付款返利_Click() '将计算明细表和付款协议表联合生成计算表 lngStartTime = timeGetTime '取时间 fTimeCount '计时开始 Dim i As Long, j As Long, q As Long, Max As Long, p As Long, mex As Long, num As Long, lilv As Single '变量说明： ' i--在循环中定位计算明细表的行数 ' j--在循环中定位付款协议表的行数 ' q--在循环中定位新生成的计算表的行数 ' Max--存储计算明细表的数据行数 ' mex--存储付款协议表的数据行数 ' num--存储计算出的付款天数 ' lilv--存储计算出的利率值 Sheet3.Range("AE1") = Format(Now(), "hh:mm:ss.ms") '另一种计时方式设置初始计时器 Max = Sheets("计算表").Cells(1, 6).Value '取值 mex = Sheets("计算表").Cells(1, 7).Value p = 3 Application.ScreenUpdating = False '循环开始前先关闭屏幕刷新，节省运算时间---注意当进行大量计算时屏幕刷新和耗费资源 '================================开始嵌套循环===================================== For i = 2 To Max '该处循环遍历计算明细表--外循环 For j = 2 To mex '该处循环遍历付款协议表--内循环 'DoEvents '该命令可使循环在运行时也可进行其他操作,但会影响速度！！少用 If Sheet1.Range("Y" & i).Value = Sheet2.Range("A" & j).Value And Sheet2.Range("X" & j).Value <> "*" Then '该处判断两表中供应商的ID号必须相同 '==有商品ID对应的== If Sheet1.Range("E" & i).Value = Sheet2.Range("C" & j).Value Then '该处判断两表商品的ID号必须相同 '两次判断定位到有返利的商品信息行 '==T类型处理== If Sheet2.Range("R" & j).Value = "T" Then '==============================有返利且付款天数类型为T的情况================================= num = fun_T(i, p, j) '在计算表中生成一条新的记录（A--AB + AD）并返回付款天数 'Call fun_jisuan(j, num, p) '频繁的嵌套式调用函数会影响时间--尽量避免超过二重的调用 Select Case Sheet2.Range("S" & j).Value '先判断付款类型 Case "A" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiA(lilv, p) Case "B" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回底价 Sheet3.Range("AE" & p).Value = fun_gongshiB(lilv, p) Case "C" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回差价 Sheet3.Range("AE" & p).Value = fun_gongshiC(lilv, p) Case "D" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiD(lilv, p) Case "E" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiE(lilv, p) Case Else MsgBox "001错误！！...无相应匹配公式..请查看表格！" End Select p = p + 1 '新生成的计算表行数加1 '==U类型处理== ElseIf Sheet2.Range("R" & j).Value = "U" Then '该处判断付款天数类型--U '==============================有返利且付款天数类型为U的情况================================= num = fun_U(i, p, j) ' Call fun_jisuan(j, num, p) Select Case Sheet2.Range("S" & j).Value '先判断付款类型 Case "A" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiA(lilv, p) Case "B" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回底价 Sheet3.Range("AE" & p).Value = fun_gongshiB(lilv, p) Case "C" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回差价 Sheet3.Range("AE" & p).Value = fun_gongshiC(lilv, p) Case "D" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiD(lilv, p) Case "E" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiE(lilv, p) Case Else MsgBox "001错误！！...无相应匹配公式..请查看表格！" End Select p = p + 1 '新生成的计算表行数加1 End If ElseIf Sheet2.Range("C" & j).Value = "所有" Then If Sheet2.Range("R" & j).Value = "T" Then '==============================商品类型为所有且付款天数类型为T的情况================================= num = fun_T(i, p, j) ' Call fun_jisuan(j, num, p) Select Case Sheet2.Range("S" & j).Value '先判断付款类型 Case "A" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiA(lilv, p) Case "B" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回底价 Sheet3.Range("AE" & p).Value = fun_gongshiB(lilv, p) Case "C" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回差价 Sheet3.Range("AE" & p).Value = fun_gongshiC(lilv, p) Case "D" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiD(lilv, p) Case "E" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiE(lilv, p) Case Else MsgBox "001错误！！...无相应匹配公式..请查看表格！" End Select p = p + 1 '新生成的计算表行数加1 ElseIf Sheet2.Range("R" & j).Value = "U" Then '==============================商品类型为所有且付款天数类型为U的情况================================= num = fun_U(i, p, j) 'Call fun_jisuan(j, num, p) Select Case Sheet2.Range("S" & j).Value '先判断付款类型，+for Case "A" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiA(lilv, p) Case "B" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回底价 Sheet3.Range("AE" & p).Value = fun_gongshiB(lilv, p) Case "C" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回差价 Sheet3.Range("AE" & p).Value = fun_gongshiC(lilv, p) Case "D" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiD(lilv, p) Case "E" lilv = fun_lilv(j, num, 7, 0, p) '注意此处返回利率比例 Sheet3.Range("AE" & p).Value = fun_gongshiE(lilv, p) Case Else MsgBox "001错误！！...无相应匹配公式..请查看表格！" End Select p = p + 1 '新生成的计算表行数加1 End If End If End If Next j Next i '================================结束嵌套循环===================================== Application.ScreenUpdating = True '循环结束后将屏幕刷新重新开启 Sheet3.Range("AG1") = Format(Now(), "hh:mm:ss.ms") '设置结束计时器 MsgBox fTimeCount '返回最终运算时间 '***************************************主程序结束************************************************** End Sub '=====================该子函数对付款协议T类型进行处理，返回付款天数 Public Function fun_T(ByVal i As Long, ByRef p As Long, ByVal j As Long) As Long With Sheet3 .Range("A" & p, "AB" & p).Value = Sheet1.Range("A" & i, "AB" & i).Value '此行将明细表中的数据存入新生成的计算表 .Range("AD" & p).Value = Sheet1.Range("V" & i).Value - Sheet1.Range("K" & i).Value - Sheet2.Range("V" & j).Value '将实际付款天数放入新表（付款天数=财务确认日期-进货时间-在途天数） .Range("AC" & p).Value = Sheet2.Range("E" & j).Value '将付款的中标价存入新表 fun_T = .Range("AD" & p).Value End With End Function '====================该子函数对付款协议U类型进行处理，返回付款天数 Public Function fun_U(ByVal i As Long, ByRef p As Long, ByVal j As Long) As Long With Sheet3 .Range("A" & p, "AB" & p).Value = Sheet1.Range("A" & i, "AB" & i).Value '此行将明细表中的数据存入新生成的计算表 .Range("AD" & p).Value = Sheet1.Range("V" & i).Value - Sheet1.Range("S" & i).Value - Sheet2.Range("V" & j) '将实际付款天数放入新表（付款天数=财务确认日期-开票日期-在途天数） .Range("AC" & p).Value = Sheet2.Range("E" & j).Value '将付款的中标价存入新表 fun_U = .Range("AD" & p).Value End With End Function '=========================该子函数对付款协议表的计算标志进行判断 Public Function fun_jisuan(ByVal j As Long, ByVal num As Long, ByVal p As Long) Dim lilv As Long 'A作为利率值 Select Case Sheet2.Range("S" & j).Value '先判断付款类型，+for Case "A" lilv = fun_lilv(j, num, 7, 0) Sheet3.Range("AE" & p).Value = fun_gongshiA(lilv, j) Case "B" lilv = fun_lilv(j, num, 7, 0) Sheet3.Range("AE" & p).Value = fun_gongshiB(lilv, j) Case "C" lilv = fun_lilv(j, num, 7, 0) Sheet3.Range("AE" & p).Value = fun_gongshiC(lilv, j) Case "D" lilv = fun_lilv(j, num, 7, 0) Sheet3.Range("AE" & p).Value = fun_gongshiD(lilv, j) Case "E" lilv = fun_lilv(j, num, 7, 0) Sheet3.Range("AE" & j).Value = fun_gongshiE(lilv, j) Case Else MsgBox "001错误！！...无相应匹配公式..请查看表格！" End Select End Function '=========================该子函数获得付款协议表中对应行对应天数的利率值，并以单精度返回 Public Function fun_lilv(ByVal j As Long, ByVal num As Long, ByVal x As Long, ByVal flag As Long, ByVal p As Long) As Single '******说明******* '注意对于一次新的调用，该函数不可能存在两次进入同一case，最差的情况是将九种情况通过递归的形式都遍历一遍 '本函数的逻辑顺序是： ' 先进行付款天数num的定位，找到后将定位值放入全局变量location，并判断对应定位区间下是否有返利率，有则返回 ' 若没有则进行递归调用，先往回扫描查询，直到定位至7，若还没有则从location+1重新进行递归调用，直到15，若还没有则报错！！ ' 后扫---前扫 '注意：标志位为1即规定为已找到区间并进行后扫，即往回找利率大的优先,标志位为2即规定为已后扫完毕，在进行前扫 '================================开始跳转，共9种合法情况===================================== Select Case x '先判断处于付款协议表中的那一列 '================================情况1-30区间===================================== Case Is = 7 If num < 30 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 30 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then flag = 2 '注意此处特殊，因为无法再进行后扫了，不加此处容易造成递归的死循环，从而使得堆栈溢出！！ fun_lilv = fun_lilv(j, num, location + 1, flag, p) '前扫！！--找利率 Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag >= 1 Then If Sheet2.Cells(j, x).Value = 0 Then flag = 2 '标志位置2--前扫！！ 'If location <= 15 Then fun_lilv = fun_lilv(j, num, location + 1, flag, p) '前扫！！--找利率 'Else 'MsgBox "002错误！！--天数大于九十，请核对对相应行数据是否存在返利率！！" ' fun_lilv = 0 '注意此处，前扫完毕但没有匹配项，而且其定位>=15，即90天，所以要求另返利为零 'End If Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) '前扫！！--定位区间 End If '================================情况2-45区间===================================== Case Is = 8 If num >= 30 And num < 45 Then '处理处于该区域的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 45 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况3-55区间===================================== Case Is = 9 If num >= 45 And num < 55 Then '处理处于该区域的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 55 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况4-60区间===================================== Case Is = 10 If num >= 55 And num < 60 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 60 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况5-65区间===================================== Case Is = 11 If num >= 60 And num < 65 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 65 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况6-70区间===================================== Case Is = 12 If num >= 65 And num < 70 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 70 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况7-75区间===================================== Case Is = 13 If num >= 70 And num < 75 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 75 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况8-80区间===================================== Case Is = 14 If num >= 75 And num < 80 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 80 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '================================情况9-90区间===================================== Case Is = 15 If num >= 80 And num <= 90 Then '处理处于该区域或者已找到的情况 location = x '记录定位区间 Sheet3.Range("AF" & p) = 90 flag = 1 '将标志位置1，表示已找到该数所处区间 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 '回找对应的返利率，此时不存在标志位为2的情况 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 1 Then '该情况是已定位完区间，正在前扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If ElseIf flag = 2 Then '该情况是已定位完区间，且以前扫完毕，正在后扫的情况 If Sheet2.Cells(j, x).Value = 0 Then '定位到该单元格，判断是否等于0 ' MsgBox "003错误！！--利率值出错！！--请核对相应行数据是否存在返利率！！" x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) Else fun_lilv = Sheet2.Cells(j, x).Value '取得利率 End If Else '处理既不在该区域又还没找到的情况 x = x + 1 fun_lilv = fun_lilv(j, num, x, flag, p) ''前扫！！--定位区间 End If '=================================情况9-->90天的情况==================================== Case Is = 16 If flag = 0 Then flag = 1 '将标志位置1，表示已找到该数所处区间 'MsgBox "004错误！！--利率计算超出合法范围！！--只针对0-90天--请核对表格数据！！" Sheet3.Range("AF" & p).Value = ">90" x = x - 1 fun_lilv = fun_lilv(j, num, x, flag, p) '将标志位置1，表示已找到该数所处区间 '定为0 ElseIf flag = 2 Then MsgBox "005错误！！无对应返利！！" End If '================================非法情况===================================== Case Else MsgBox "005错误！！无对应返利！！" End Select '================================结束跳转===================================== End Function '============================该子函数对公式A的计算====付款数量*进货单价*返利比例 Public Function fun_gongshiA(ByVal lilv As Single, ByVal p As Long) As Single Sheet3.Range("AG" & p).Value = lilv '先把利率写入新表 fun_gongshiA = Sheet3.Range("M" & p).Value * Sheet3.Range("T" & p).Value * lilv End Function '===========================该子函数对公式B的计算====（进货单价-底价）*付款数量 Public Function fun_gongshiB(ByVal lilv As Single, ByVal p As Long) As Single ' Sheet3.Range("AG" & p).Value = lilv '先把底价写入新表 fun_gongshiB = (Sheet3.Range("M" & p).Value - lilv) * Sheet3.Range("T" & p).Value End Function '============================该子函数对公式c的计算====付款数量*差价 Public Function fun_gongshiC(ByVal lilv As Single, ByVal p As Long) As Single ' Sheet3.Range("AG" & p).Value = lilv '先把差价写入新表 fun_gongshiC = Sheet3.Range("T" & p).Value * lilv End Function '===========================该子函数对公式D的计算====付款数量*中标价*返利比例 Public Function fun_gongshiD(ByVal lilv As Single, ByVal p As Long) As Single ' Sheet3.Range("AG" & p).Value = lilv '先把利率写入新表 fun_gongshiD = Sheet3.Range("AC" & p).Value * Sheet3.Range("T" & p).Value * lilv End Function '===========================该子函数对公式E的计算====付款数量*合同进价*比例/1.17 Public Function fun_gongshiE(ByVal lilv As Single, ByVal p As Long) As Single Sheet3.Range("AG" & p).Value = lilv '先把利率写入新表 fun_gongshiE = Sheet3.Range("M" & p).Value * Sheet3.Range("T" & p).Value * lilv / 1.17 End Function '============================该子函数完成进行计时功能！！ Private Function fTimeCount() As String Static lngST As Long If lngST = 0& Then lngST = timeGetTime Else fTimeCount = "该运算用时 :" & Str$((timeGetTime - lngST) / 1000) & " 秒！！" lngST = 0& End If End Function '====================问题总结======================== '遇到的问题： '变量未定义--------注意为保持程序的严谨性，应注意声明变量，防止不必要的错误。。。。。。 '溢出堆栈空间------- '以下几种情况比较多: '1、递归的使用（包括大量使用sub&function）-----内部有死循环 '2、内存释放不规范，造成泄漏 '在运行时过程中的参数和局部变量占用堆栈空间。而模块级变量和静态变量不占堆栈空间，因为它们被分配在窗体或模块的数据段中。任何被调用的 DLL 过程，在执行时都要使用堆栈。 'Visual Basic 自己也使用堆栈，例如，在计算表达式时保存中间值。 'Visual Basic全部可用堆栈的大小是每线程一兆字节（1MB）。然而，如果有相邻的闲置内存，堆栈的大小可以超过这个限定。 '==================================================== '************************** 2009-7-6 结 '==================================================***结束***===========================================================