理财收支管理代码doc.doc
【精品文档】如有侵权,请联系网站删除,仅供学习与交流理财收支管理代码doc.精品文档.Excel收支管理系统程序功能:l 银行信息记录a) 存款利息计算b) 银行总资金汇总c) 银行年收益计算l 收支记录a) 收入项目记录,增加到银行账户b) 支出项目记录,选择支出账户c) 可对每条记录进行修改,并与账户关联d) 收支项目管理,可增加或删除收支项目本程序操作灵活,界面人性化,比如删除“银行记录”金额,可将本条记录信息全部删除(需要确认);收支记录中信息输入完整,自动与银行账户信息关联;可自己添加银行并修改利率。使用本程序可快速判别存款方式对收益的影响,比如5万存入工商银行:1. 整存整取两年,利息44002. 整存整取一年,利息3561(两年后取)现在银行利率也有差别,存不同银行收益相差多少也能方便了解。界面“银行记录”“银行记录”中复制代码如下:Private Sub Calendar1_Click()ActiveCell = Calendar1Calendar1.Visible = FalseEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)Dim lvDim zhuancun(1 To 100)Dim lv_huo(1 To 1000)Dim lv_ding1_3(1 To 1000)Dim lv_ding1_6(1 To 1000)Dim lv_ding1_12(1 To 1000)Dim lv_ding1_24(1 To 1000)Dim lv_ding1_36(1 To 1000)Dim lv_ding1_60(1 To 1000)Dim lv_ding2_12(1 To 1000)Dim lv_ding2_36(1 To 1000)Dim lv_ding2_60(1 To 1000)Dim rng As Rangern = Range("b65536").End(xlUp).Row '最大行号cn = Range("b2").End(xlToRight).Column '最大列号Application.ScreenUpdating = False'数据初始化If Sheet1.Cells(ActiveCell.Row, 1) = "" And Sheet1.Cells(ActiveCell.Row, 3) = "" And Sheet1.Cells(ActiveCell.Row, 2) <> "" Then Sheet1.Cells(ActiveCell.Row, 1) = "中国银行"End IfFor y = 3 To rn If Sheet1.Cells(y, 1) <> "" Then Sheet4.Select '查找银行名称 Set rng = Sheet4.B:B.Find(Sheet1.Cells(y, 1) '定位银行 If Not rng Is Nothing Then 'rng.Font.ColorIndex = 3 '颜色暂不设置 Application.Goto Reference:=rng.Address(, , xlR1C1) End If End If lv_huo(y) = Sheet4.Cells(ActiveCell.Row + 3, ActiveCell.Column + 1) lv_ding1_3(y) = Sheet4.Cells(ActiveCell.Row + 6, ActiveCell.Column + 1) lv_ding1_6(y) = Sheet4.Cells(ActiveCell.Row + 7, ActiveCell.Column + 1) lv_ding1_12(y) = Sheet4.Cells(ActiveCell.Row + 8, ActiveCell.Column + 1) lv_ding1_24(y) = Sheet4.Cells(ActiveCell.Row + 9, ActiveCell.Column + 1) lv_ding1_36(y) = Sheet4.Cells(ActiveCell.Row + 10, ActiveCell.Column + 1) lv_ding1_60(y) = Sheet4.Cells(ActiveCell.Row + 11, ActiveCell.Column + 1) lv_ding2_12(y) = Sheet4.Cells(ActiveCell.Row + 13, ActiveCell.Column + 1) lv_ding2_36(y) = Sheet4.Cells(ActiveCell.Row + 14, ActiveCell.Column + 1) lv_ding2_60(y) = Sheet4.Cells(ActiveCell.Row + 15, ActiveCell.Column + 1) '返回sheet“银行项目” Sheet1.SelectNext'格式初始化With Range(Sheet1.Cells(3, 1), Sheet1.Cells(rn + 30, cn).Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0End With'取消列表 With Sheet1.Range("A:A").Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With With Sheet1.Range("C:C").Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With '银行列表更新 rn4 = Sheet4.Range("e65536").End(xlUp).Row f = "=基本信息!E5:E" & rn4 & "" With Range("A3").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=f .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With'项目列表 With Range("C3").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="活期,整存整取,整存零取,零存整取,存本取息,定活两便" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End WithFor Z = 3 To rn '银行列表更新 rn4 = Sheet4.Range("e65536").End(xlUp).Row f = "=基本信息!E5:E" & rn4 & "" With Range("A" & Z + 1).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=f .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With '项目列表 With Range("C" & Z + 1).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="活期,整存整取,整存零取,零存整取,存本取息,定活两便" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With '年利率 If Sheet1.Cells(Z, 3) = "Huo" Or Sheet1.Cells(Z, 3) = "活期" Then lv = lv_huo(Z) Sheet1.Cells(Z, 6) = lv End If If Sheet1.Cells(Z, 3) = "ZZ" Or Sheet1.Cells(Z, 3) = "整存整取" Then If Sheet1.Cells(Z, 5) < 6 Then lv = lv_ding1_3(Z) '3个月 End If If Sheet1.Cells(Z, 5) >= 6 And Sheet1.Cells(Z, 5) < 12 Then lv = lv_ding1_6(Z) '半年 End If If Sheet1.Cells(Z, 5) >= 12 And Sheet1.Cells(Z, 5) < 24 Then lv = lv_ding1_12(Z) '1年 End If If Sheet1.Cells(Z, 5) >= 24 And Sheet1.Cells(Z, 5) < 36 Then lv = lv_ding1_24(Z) '2年 End If If Sheet1.Cells(Z, 5) >= 36 And Sheet1.Cells(Z, 5) < 60 Then lv = lv_ding1_36(Z) '3年 End If If Sheet1.Cells(Z, 5) >= 60 Then lv = lv_ding1_60(Z) '5年 End If Sheet1.Cells(Z, 6) = lv End If If Sheet1.Cells(Z, 3) = "ZL LZ BX" Or Sheet1.Cells(Z, 3) = "零存整取" Or Sheet1.Cells(Z, 3) = "整存零取" Or Sheet1.Cells(Z, 3) = "存本取息" Then If Sheet1.Cells(Z, 5) >= 12 And Sheet1.Cells(Z, 5) < 36 Then lv = lv_ding2_12(Z) '1年 End If If Sheet1.Cells(Z, 5) >= 36 And Sheet1.Cells(Z, 5) < 60 Then lv = lv_ding2_36(Z) '3年 End If If Sheet1.Cells(Z, 5) >= 60 Then lv = lv_ding2_60(Z) '5年 End If Sheet1.Cells(Z, 6) = lv End If If Sheet1.Cells(Z, 3) = "定活两便" Then If Sheet1.Cells(Z, 4) = "" And Sheet1.Cells(Z, 5) = "" Then dh = MsgBox("未区分各家银行计算方法,结果不一定准确,按利率60%计算?", vbYesNo, "提示") If dh = vbYes Then If Sheet1.Cells(Z, 5) < 6 Then lv = lv_ding1_3(Z) '3个月 End If If Sheet1.Cells(Z, 5) >= 6 And Sheet1.Cells(Z, 5) < 12 Then lv = lv_ding1_6(Z) '半年 End If If Sheet1.Cells(Z, 5) >= 12 And Sheet1.Cells(Z, 5) < 24 Then lv = lv_ding1_12(Z) '1年 End If If Sheet1.Cells(Z, 5) >= 24 And Sheet1.Cells(Z, 5) < 36 Then lv = lv_ding1_24(Z) '2年 End If If Sheet1.Cells(Z, 5) >= 36 And Sheet1.Cells(Z, 5) < 60 Then lv = lv_ding1_36(Z) '3年 End If If Sheet1.Cells(Z, 5) >= 60 Then lv = lv_ding1_60(Z) '5年 End If lv = lv * 0.6 Else Sheet1.Cells(Z, 3) = "" End If Else If Sheet1.Cells(Z, 5) < 6 Then lv = lv_ding1_3(Z) '3个月 End If If Sheet1.Cells(Z, 5) >= 6 And Sheet1.Cells(Z, 5) < 12 Then lv = lv_ding1_6(Z) '半年 End If If Sheet1.Cells(Z, 5) >= 12 And Sheet1.Cells(Z, 5) < 24 Then lv = lv_ding1_12(Z) '1年 End If If Sheet1.Cells(Z, 5) >= 24 And Sheet1.Cells(Z, 5) < 36 Then lv = lv_ding1_24(Z) '2年 End If If Sheet1.Cells(Z, 5) >= 36 And Sheet1.Cells(Z, 5) < 60 Then lv = lv_ding1_36(Z) '3年 End If If Sheet1.Cells(Z, 5) >= 60 Then lv = lv_ding1_60(Z) '5年 End If lv = lv * 0.6 End If Sheet1.Cells(Z, 6) = lv End If On Error Resume Next If Target.Column = 4 And Target.Value <> "存入日期" And Target.Row > 2 And Target.Row <= rn Then Calendar1.Visible = True '日历控件 Calendar1.Left = Cells(Target.Row, 4).Left Calendar1.Top = Cells(Target.Row + 1, 4).Top With Calendar1 '当前日期 .Year = Year(Now) .Month = Month(Now) .Day = Day(Now) End With ElseIf Target.Column = 1 And Target.Row = 1 Then Calendar1.Visible = True '日历控件 Calendar1.Left = Cells(Target.Row, 1).Left Calendar1.Top = Cells(Target.Row + 1, 1).Top With Calendar1 '当前日期 .Year = Year(Now) .Month = Month(Now) .Day = Day(Now) End With Else Calendar1.Visible = False End If On Error Resume Next nian = Int(Sheet1.Cells(Z, 5) / 12) '年数 yue = Sheet1.Cells(Z, 5) - 12 * nian '月数 lixishui = 0 '利息税率 daoqi = Sheet1.Cells(Z, 2) + Sheet1.Cells(Z, 2) * (lv / 100) * (Sheet1.Cells(Z, 5) / 12) * (1 - lixishui) '到期总数 '当前日期与存入日期相差月数 If Year(Sheet1.Cells(1, 1) >= Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) >= Month(Sheet1.Cells(Z, 4) And Day(Sheet1.Cells(1, 1) >= Day(Sheet1.Cells(Z, 4) Then m = (Year(Sheet1.Cells(1, 1) - Year(Sheet1.Cells(Z, 4) * 12 + Month(Sheet1.Cells(1, 1) - Month(Sheet1.Cells(Z, 4) End If If Year(Sheet1.Cells(1, 1) >= Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) >= Month(Sheet1.Cells(Z, 4) And Day(Sheet1.Cells(1, 1) < Day(Sheet1.Cells(Z, 4) Then m = (Year(Sheet1.Cells(1, 1) - Year(Sheet1.Cells(Z, 4) * 12 + Month(Sheet1.Cells(1, 1) - Month(Sheet1.Cells(Z, 4) - 1 End If If Year(Sheet1.Cells(1, 1) >= Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) < Month(Sheet1.Cells(Z, 4) And Day(Sheet1.Cells(1, 1) >= Day(Sheet1.Cells(Z, 4) Then m = (Year(Sheet1.Cells(1, 1) - Year(Sheet1.Cells(Z, 4) * 12 - Month(Sheet1.Cells(1, 1) + Month(Sheet1.Cells(Z, 4) End If If Year(Sheet1.Cells(1, 1) >= Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) < Month(Sheet1.Cells(Z, 4) And Day(Sheet1.Cells(1, 1) >= Day(Sheet1.Cells(Z, 4) Then m = (Year(Sheet1.Cells(1, 1) - Year(Sheet1.Cells(Z, 4) * 12 - Month(Sheet1.Cells(1, 1) + Month(Sheet1.Cells(Z, 4) - 1 End If If Year(Sheet1.Cells(1, 1) < Year(Sheet1.Cells(Z, 4) Then m = 0 End If If Year(Sheet1.Cells(1, 1) = Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) < Month(Sheet1.Cells(Z, 4) Then m = 0 End If If Year(Sheet1.Cells(1, 1) = Year(Sheet1.Cells(Z, 4) And Month(Sheet1.Cells(1, 1) = Month(Sheet1.Cells(Z, 4) And Day(Sheet1.Cells(1, 1) < Day(Sheet1.Cells(Z, 4) Then m = 0 End If zhuan = Int(m / Sheet1.Cells(Z, 5) - 1 '转存次数 If zhuan < 0 Then zhuan = 0 End If '数据写入 If Z > 2 And Sheet1.Cells(Z, 6) <> "" Then Sheet1.Cells(Z, 7) = daoqi '-到期总数 If Sheet1.Cells(Z, 4) <> "" Then Sheet1.Cells(Z, 8).FormulaR1C1 = _ "=DATE(YEAR(RC-4),MONTH(RC-4)+RC-3,DAY(RC-4)" '-到期日期 End If End If If Sheet1.Cells(Z, 7) <> "" Then Sheet1.Cells(Z, 9) = (Sheet1.Cells(Z, 7) - Sheet1.Cells(Z, 2) '-利息 Else Sheet1.Cells(Z, 9) = "" End If Sheet1.Cells(Z, 10) = zhuan '-转存次数 zhuancun(1) = Sheet1.Cells(Z, 7) + Sheet1.Cells(Z, 7) * (lv / 100) * (Sheet1.Cells(Z, 5) / 12) * (1 - lixishui) '第一次转存到期总数 If zhuan >= 2 Then For i = 2 To zhuan zhuancun(i) = zhuancun(i - 1) + zhuancun(i - 1) * (lv / 100) * (Sheet1.Cells(Z, 5) / 12) * (1 - lixishui) Next End If If Int(m / Sheet1.Cells(Z, 5) = m / Sheet1.Cells(Z, 5) Then Sheet1.Cells(Z, 11).FormulaR1C1 = _ "=DATE(YEAR(RC-7),MONTH(RC-7)+RC-6*(RC-1+1),DAY(RC-7)" '-转存到期日期 Else Sheet1.Cells(Z, 11).FormulaR1C1 = _ "=DATE(YEAR(RC-7),MONTH(RC-7)+RC-6*(RC-1+1),DAY(RC-7)" '-转存到期日期 End If If zhuan < 1 Then Sheet1.Cells(Z, 10) = "" Sheet1.Cells(Z, 11) = "" Sheet1.Cells(Z, 12) = Sheet1.Cells(Z, 7) Sheet1.Cells(Z, 13) = Sheet1.Cells(Z, 9) Else Sheet1.Cells(Z, 12) = zhuancun(zhuan) '-当前总额 Sheet1.Cells(Z, 13) = Sheet1.Cells(Z, 12) - Sheet1.Cells(Z, 2) '-当前利息 End If '格式 If Z Mod 2 = 1 Then '当前行数除以2的余数为1(奇数) With Range(Sheet1.Cells(Z, 1), Sheet1.Cells(Z, 14).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 10198015 .TintAndShade = 0 .PatternTintAndShade = 0 End With ElseIf Z Mod 2 = 0 Then '当前行数除以2的余数为0(偶数) With Range(Sheet1.Cells(Z, 1), Sheet1.Cells(Z, 14).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 13421823 .TintAndShade = 0 .PatternTintAndShade = 0 End With End If '未选择银行不计利率 If Sheet1.Cells(Z, 1) = "" Then lv = 0 Sheet1.Cells(Z, 6) = "" Sheet1.Cells(Z, 7) = "" Sheet1.Cells(Z, 9) = "" End If '活期不考虑到期时间,按存入时间到当前日期利息计算 If Sheet1.Cells(Z, 3) = "活期" Then tian = Date - Sheet1.Cells(Z, 4) nian1 = Int(tian / 365) '年数 yue1 = Sheet1.Cells(Z, 5) - 12 * nian '月数 Sheet1.Cells(Z, 7) = Sheet1.Cells(Z, 2) + Sheet1.Cells(Z, 2) * lv / 100 * (tian / 365) Sheet1.Cells(Z, 9) = Sheet1.Cells(Z, 7) - Sheet1.Cells(Z, 2) Sheet1.Cells(Z, 5) = "" Sheet1.Cells(Z, 6) = lv Sheet1.Cells(Z, 8) = "" Sheet1.Cells(Z, 10) = "" Sheet1.Cells(Z, 11) = "" Sheet1.Cells(Z, 12) = Sheet1.Cells(Z, 7) Sheet1.Cells(Z, 13) = Sheet1.Cells(Z, 9) End