请帮我看看这个VBA模块怎么修改，万分感激！

ophelialee · 发表于 2019-8-26 09:55

我在进行一个全年统计，包括内容如下，

月	日	收入比例-q	实际收入-R	每日支出-QY	本日尚可用花销-S	上日结余-b1	每日借款-CW	存款上限-V	可存入-b2
1	1	0		100				150
1	2	13		100				150
1	3	16		100				150
1	4	0		100				150
1	5	3		100				150
1	6	4		100				150
1	7	11		100				150
1	8	3		100				150
1	9	0		100				150
1	10	0		100				150
1	11	0		100				150
1	12	0		100				150
1	13	0		100				150
1	14	0		100				150
1	15	0		100				150
1	16	2		100				150
1	17	19		100				150
1	18	0		100				150
1	19	0		100				150
1	20	0		100				150
1	21	0		100				150
1	22	7		100				150
1	23	1		100				150

.......
表格没粘贴完，一共是366行，全年数据，QY和V的数值是常数，100和150是我便于计算随便填的。
其中R可通过q计算得出，(每日支出QY)和(存款上限V)是某一给定常数，当年第一天即1月1日b1=0，此后，按如下规则计算：1、对于当年第i天，当日收入R（i）+上日结余b1（i），如果超过存款上限V，则当日最大可存入b2=V，如果未超过，则认为当日最大可存入b2=b1+R，而i+1行的上日结余b1（i+1）=b2（i+1）-QY，即b1（i+1）=max(0, b2（i）-QY)，b2（i）=min(V, R+b1（i）)。
2、如果b2-QY>0，即当日可存入可以弥补当日支出，则当日借款CW为0，本日尚可用花销S=R+b1-V；如果b2-QY<0，即当日可存入不能弥补当日支出，则当日借款CW为QY-b2，本日尚可用花销S=0，即CW=max(QY-b2,0)，S=max(R+b1-v, 0)；
目的是想统计当年每一日的收支平和情况，即已知q，计算出R后，对于给定的QY和V，求得每天的b1，b2，cw和s。
我编写的模块和计算流程图详见附件。但模块没法运行，我也找不到原因，刚开始学习VBA，实在是被规则绕的有点蒙圈，多谢各位！！

rardge2015 · 发表于 2019-8-26 12:07

本帖最后由 rardge2015 于 2019-8-26 12:16 编辑

你的表述我看不懂，所以只是把代码上发现的问题解决了，可以运行了，但结果对不对就不知道了。

arr = Array("a2:d" & Rng)

复制代码

上述代码出有问题，你本意是要把 A2 到 D<Rng> 的数据读入内存，但你用 Array（）这个语法，导致 arr 得到的仅仅是：“A2:D366”这样一个字符串，所以后续 For 循环根本不会执行，程序直接结束。所以你碰到的问题应该就是这个吧，程序执行了没有任何反应。改成以下写法：

arr = Sheets("汇总该年").Range("A1").Resize(Rng, 4)

复制代码

我为什么改成把标题行也读取，是考虑到后面的程序中各变量取值都是从第二行开始，为了尽可能少的修改代码，就把标题行也读入数组了。
修正以上错误后，还有个细节。以下写法又错了：

For t = 1 To UBound(arr, 1)

复制代码

你的数据是有标题行的，计算的数据要从下一行开始。但 t = 1，代表首先从标题行开始计算。分析 For 循环中的 q 等取值就可以知道错误了。所以要改成 t = 2，改成以下代码：

For t = 2 To UBound(arr, 1)

复制代码

修改后，程序可以执行了，但结果是否符合你的预期，请自行核查。

ophelialee · 发表于 2019-8-26 18:19

rardge2015 发表于 2019-8-26 12:07
你的表述我看不懂，所以只是把代码上发现的问题解决了，可以运行了，但结果对不对就不知道了。
上述代码出 ...

非常感谢您的指导，已经可以运行了，还是有个小问题请指教，请问怎么对初始值进行赋值呢？因为按照修改后的模块，第一行是没有数据，我理解是因为我没有进行变量初始值进行赋值，那么b1=0和b1=b1+1应该具体放在什么位置才能正确运行呢，我尝试了几个位置第一行都不出现计算结果，如下所示：

月	日	收入比例-q	实际收入-R	每日支出-QY	本日尚可用花销-S	上日结余-b1	每日借款-CW	存款上限-V	可存入-b2
1	1	0		100				150
1	2	13	0	100	0	0	100	150
1	3	16	19.8	100	0	0	80.2	150
1	4	0	25.2	100	0	0	74.8	150
1	5	3	0	100	0	0	100	150
1	6	4	1.8	100	0	0	98.2	150
1	7	11	3.6	100	0	0	96.4	150
1	8	3	16.2	100	0	0	83.8	150
1	9	0	1.8	100	0	0	98.2	150
1	10	0	0	100	0	0	100	150
1	11	0	0	100	0	0	100	150
1	12	0	0	100	0	0	100	150
1	13	0	0	100	0	0	100	150
1	14	0	0	100	0	0	100	150
1	15	0	0	100	0	0	100	150
1	16	2	0	100	0	0	100	150
1	17	19	0	100	0	0	100	150

rardge2015 · 发表于 2019-8-27 12:46

Option Explicit
Sub tongji()
'既然是常数，就在这里直接定义金额，不要再从表格中读取
Const QY = 100
Const V = 150
Dim shtName As Worksheet
Dim recNum As Integer
Dim t As Integer
Dim q As Currency, R As Currency, b1 As Currency, j As Currency, b2 As Currency, k As Currency, S As Currency, CW As Currency
Set shtName = Sheets("汇总该年")
recNum = shtName.Cells(Rows.Count, 1).End(xlUp).Row - 1
'清空计算区域
shtName.Cells(2, "E").Resize(recNum, 7).Clear
'上日结余赋初值
b1 = 0
'设置从 2 开始，是为了避开标题行
For t = 2 To recNum + 1
'当日初始化，将上日结余、每日支出、存款上限写入表格
Cells(t, "H") = Format(b1, "#,##0.00")
Cells(t, "F") = Format(QY, "#,##0.00")
Cells(t, "J") = Format(V, "#,##0.00")
'从表格当日收入比例
q = shtName.Cells(t, "D")
'计算当日实际收入
If q - 2 > 0 Then
R = 2000 * (q - 2) * 0.9 * 0.001
Else
R = 0
End If
'上日结余 + 今日收入 > 存款上限
' 超过存款上限部分，作为今日可花销金额
' 其余部分，作为可存入
'上日结余 + 今日收入 < 存款上限
' 全部作为可存入
j = R + b1
If j > V Then
S = j - V
b2 = V
Else
S = 0
b2 = j
End If
'可存入 - 每日支出
'透支：借款，并上日结余 = 0
'盈余：不借款，上日结余 = 盈余
k = b2 - QY
If k < 0 Then
CW = -k
b1 = 0
Else
CW = 0
b1 = k
End If
Cells(t, "E") = Format(R, "#,##0.00")
Cells(t, "G") = Format(S, "#,##0.00")
Cells(t, "I") = Format(CW, "#,##0.00")
Cells(t, "K") = Format(b2, "#,##0.00")
Next t
End Sub

复制代码

ophelialee · 发表于 2019-8-28 08:52

rardge2015 发表于 2019-8-27 12:46

对您的无私帮助，再次表示感谢！！

		自动登录	找回密码
密码			注册