Excel理财收支管理代码.docx

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 And Sheet1.Cells(Z, 5) = 12 And Sheet1.Cells(Z, 5) = 24 And Sheet1.Cells(Z, 5) = 36 And 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 And 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 And Sheet1.Cells(Z, 5) = 12 And Sheet1.Cells(Z, 5) = 24 And Sheet1.Cells(Z, 5) = 36 And 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 And Sheet1.Cells(Z, 5) = 12 And Sheet1.Cells(Z, 5) = 24 And Sheet1.Cells(Z, 5) = 36 And 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 = 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) = Year(Sheet1.Cells(Z, 4) And Month(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) = 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 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 If 未选择存入时间 If Sheet1.Cells(Z, 4) = Then Sheet1.Cells(Z, 9) = Sheet1.Cells(Z, 10) = Sheet1.Cells(Z, 11) = Sheet1.Cells(Z, 13) = Sheet1.Cells(Z, 7) = Sheet1.Cells(Z, 2) Sheet1.Cells(Z, 12) = Sheet1.Cells(Z, 2) End If 到期提示 If Sheet1.Cells(Z, 8) Sheet1.Cells(1, 1) Then With Sheet1.Cells(Z, 8).Font .Color = -65281 .TintAndShade = 0 End With Else With Sheet1.Cells(Z, 8).Font .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 End With End If If Sheet1.Cells(Z, 11) Sheet1.Cells(1, 1) Then With Sheet1.Cells(Z, 11).Font .Color = -65281 .TintAndShade = 0 End With Else With Sheet1.Cells(Z, 11).Font .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 End With End IfNext-For j = 3 To rn + 1000 If Sheet1.Cells(j, 2) = And Sheet1.Cells(j, 3) Then sc = MsgBox(确认删除该项目？, vbYesNo, 提示) If sc = vbYes Then Sheet1.Cells(j, 1) = Sheet1.Cells(j, 3) = Sheet1.Cells(j, 4) = Sheet1.Cells(j, 5) = Sheet1.Cells(j, 6) = Sheet1.Cells(j, 7) = Sheet1.Cells(j, 8) = Sheet1.Cells(j, 9) = Sheet1.Cells(j, 10) = Sheet1.Cells(j, 11) = Sheet1.Cells(j, 12) = Sheet1.Cells(j, 13) = Sheet1.Cells(j, 14) = End If Rows(j).Delete End IfNext图表数据处理图表1，饼图，显示各银行资金分布Sheet6.Columns(A:B).ClearSheet6.Cells(1, 1) = 图表1zong = 0ben = 0nianli = 0For K = 3 To rn rn1 = Sheet6.Range(a65536).End(xlUp).Row If rn1 = 2 Then ActiveSheet.ChartObjects(图表 1).Activate ActiveChart.SetSource