[已解决]想做个台帐，请大侠们帮忙

假绅士

我想做个台帐，希望用VBA来解决，我自己编了段简单的代码，虽然最后效果是一样的，但是只能当作给各位大侠的提示吧，具体内容请大侠们看附件里吧！！谢谢！！！！

最佳答案

月排行榜 / 总排行榜

grf1973

2014-12-29 15:41

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     x = Target.Row
   
4.     If Target.Column < 9 Or Target.Column > 10 Or x < 3 Then Exit Sub
   
5.     Application.EnableEvents = False
   
6.     Cells(x, 1) = x - 2  '编号
   
7.     Cells(x, 7) = Cells(x, 5) - Cells(x, 4)      '协议天数
   
8.     Cells(x, 8) = IIf(Cells(x, 6) = "", Cells(x, 7), Cells(x, 6) - Cells(x, 4))     '实际天数
   
9.    
   
10.     a = Cells(x, 3): b = Cells(x, 7)
    
11.     d = Cells(x, 9): e = Cells(x, 10)
    
12.     Cells(x, 11) = Round(a * d * b / 360 * 10000 + 0.0001, 2)         '协议利率
    
13.     Cells(x, 12) = IIf(Cells(x, 10) = "", Cells(x, 11), Round(a * e * b / 360 * 10000 + 0.0001, 2))      '实际利率
    
14.    
    
15.     If IsDate(Cells(x, 5)) Then        '是否划回
    
16.         If Cells(x, 5) <= Date Then Cells(x, "M") = "已划回" Else Cells(x, "M") = "未划回"
    
17.     End If
    
18.     If IsDate(Cells(x, 6)) Then
    
19.         If Cells(x, 6) <= Date Then Cells(x, "M") = "已划回" Else Cells(x, "M") = "未划回"
    
20.     End If
    
21.     Application.EnableEvents = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

grf1973

尽量不改你的代码：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     x = Target.Row
   
4.     If Target.Column < 9 Or Target.Column > 10 Or x < 3 Then Exit Sub
   
5.     a = Cells(x, 3): b = Cells(x, 7)
   
6.     d = Cells(x, 9): e = Cells(x, 10)
   
7.     Cells(x, 1) = x - 2
   
8.     Cells(x, 7) = DateDiff("d", Cells(x, 4), Cells(x, 5))
   
9.     Cells(x, 11) = Round(a * d * b / 360 * 10000 + 0.0001, 2)
   
10.     If Cells(x, 6) = "" Then
    
11.         Cells(x, 8) = DateDiff("d", Cells(x, 4), Cells(x, 5))
    
12.     Else
    
13.         Cells(x, 8) = DateDiff("d", Cells(x, 4), Cells(x, 6))
    
14.     End If
    
15.     If Cells(x, 10) = "" Then
    
16.         Cells(x, 12) = Round(a * d * b / 360 * 10000 + 0.0001, 2)
    
17.     Else
    
18.         Cells(x, 12) = Round(a * e * b / 360 * 10000 + 0.0001, 2)
    
19.     End If
    
20. End Sub

复制代码

grf1973

请看附件。

假绅士

grf1973 发表于 2014-12-29 14:47
尽量不改你的代码：

谢谢您的帮助，不过有两个问题，还需要您帮忙解答一下：
1、当我输入“协议利率”后，两个利息单元格显示“0.00”，只有我输入第二遍的时候才显示正确的利息。这个问题能解决么？不用我的代码也行。我只是抛个砖。
2、请您帮我把划回标志那个部分也做进去吧！！

谢谢您

grf1973

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     x = Target.Row
   
4.     If Target.Column < 9 Or Target.Column > 10 Or x < 3 Then Exit Sub
   
5.     Application.EnableEvents = False
   
6.     Cells(x, 1) = x - 2  '编号
   
7.     Cells(x, 7) = Cells(x, 5) - Cells(x, 4)      '协议天数
   
8.     Cells(x, 8) = IIf(Cells(x, 6) = "", Cells(x, 7), Cells(x, 6) - Cells(x, 4))     '实际天数
   
9.    
   
10.     a = Cells(x, 3): b = Cells(x, 7)
    
11.     d = Cells(x, 9): e = Cells(x, 10)
    
12.     Cells(x, 11) = Round(a * d * b / 360 * 10000 + 0.0001, 2)         '协议利率
    
13.     Cells(x, 12) = IIf(Cells(x, 10) = "", Cells(x, 11), Round(a * e * b / 360 * 10000 + 0.0001, 2))      '实际利率
    
14.    
    
15.     If IsDate(Cells(x, 5)) Then        '是否划回
    
16.         If Cells(x, 5) <= Date Then Cells(x, "M") = "已划回" Else Cells(x, "M") = "未划回"
    
17.     End If
    
18.     If IsDate(Cells(x, 6)) Then
    
19.         If Cells(x, 6) <= Date Then Cells(x, "M") = "已划回" Else Cells(x, "M") = "未划回"
    
20.     End If
    
21.     Application.EnableEvents = True
    
22. End Sub

复制代码

grf1973

原来的代码中，abde定义的位置不对，应该在cells(x,7)之后。

假绅士

grf1973 发表于 2014-12-29 15:42
原来的代码中，abde定义的位置不对，应该在cells(x,7)之后。

对不起，老师，之前没说明白，“划回标志”是根据当前日期实时变动的，那样怎么改啊？

grf1973

直接用公式

假绅士

grf1973 发表于 2014-12-29 19:42
直接用公式

好的，谢谢老师！！！