请教VBA高手

ok_welcome

现金日记账.rar (106.45 KB, 下载次数: 60)

2011-11-17 20:30 上传

点击文件名下载附件

看附件，里边余额是用函数实现的，那么，如何用宏来实现这个功能呢？

ok_welcome

Bernard_ye 发表于 2011-11-17 21:00
Sub balance()
Dim i As Long
i = 8

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 5 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
If Target.Value = "本月合计" Then
m = Target.Row - 1
i = Range("C" & m + 1).End(xlUp).Row
Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
ElseIf Target.Value = "本年累计" Then
n = Target.Row - 2
Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
End If
End Sub

怎么跟这个代码合在一起呢？并自动执行！！！谢谢！！

Bernard_ye

Sub balance()
Dim i As Long
i = 8
Do While Range("G" & i) <> ""
    Select Case Range("G" & i)
        Case "过　次　页", "承　前　页", "本月合计", "本年累计"
            Range("L" & i).Value = Range("L" & (i - 1)).Value
        Case Else
            Range("L" & i).Value = Range("L" & (i - 1)).Value + Range("H" & i).Value - Range("J" & i).Value
    End Select
    i = i + 1
Loop
End Sub

Bernard_ye

请见以下完整代码：
[code=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 5 Then Exit Sub
If Target.Column = 7 Then
Select Case Target.Value
    Case "本月合计"
        m = Target.Row - 1
        i = Range("C" & m + 1).End(xlUp).Row
        Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
        Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
        Range("L" & m + 1) = Range("L" & m)
    Case "本年累计"
        m = Target.Row - 2
        Range("H" & m + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & m & ">0)*H$6:H" & m & ")")
        Range("J" & m + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & m & ">0)*J$6:J" & m & ")")
        Range("L" & m + 2) = Range("L" & m + 1)
    Case ""
        m = Target.Row
        Range("H" & m) = ""
        Range("J" & m) = ""
        Range("L" & m) = ""
    Case Else
        m = Target.Row
        Range("L" & m) = Range("H" & m) + Range("L" & m - 1) - Range("J" & m)
End Select
End If
If Target.Column = 8 Or Target.Column = 10 Then
    m = Target.Row
    Select Case Range("G" & m).Value
        Case "本月合计", "本年累计", "过 次 页", "承 前 页"
            Exit Sub
        Case Else
            If Range("H" & m) <> "" Or Range("J" & m) <> "" Then
                Range("L" & m) = Range("H" & m) + Range("L" & m - 1) - Range("J" & m)
            End If
    End Select
End If
End Sub
[/code]

风云际会6

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 6 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
If Target.Value = "本月合计" Then
m = Target.Row
i = Range("C" & m).End(xlUp).Row
a = m + 1
Range("H" & m) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
Range("J" & m) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
ElseIf Target.Value = "本年累计" Then
n = Target.Row
Range("H" & n) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
Range("J" & n) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
End If
Dim s As Long
s = 8
Do While Range("G" & s) <> ""
    Select Case Range("G" & s)
        Case "过　次　页", "承　前　页", "本月合计", "本年累计"
            Range("L" & s).Value = Range("L" & (s - 1)).Value
        Case Else
            Range("L" & s).Value = Range("L" & (s- 1)).Value + Range("H" & s).Value - Range("J" & s).Value
    End Select
    s = s + 1
Loop
End Sub

ok_welcome

Bernard_ye 发表于 2011-11-17 22:46
请见以下完整代码：

真厉害~！谢谢哦！！！

ok_welcome

风云际会6 发表于 2011-11-17 22:47
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 6 Then Ex ...

这个有点小问题！我要的是在H,J列有数据输入时，在同一行的余额要算出余额来，而不是在下一行算出来！

ok_welcome

Bernard_ye 发表于 2011-11-17 22:46
请见以下完整代码：

现金日记账1.rar (69.56 KB, 下载次数: 11)

2011-11-17 23:26 上传

点击文件名下载附件

你好！我想在附件里这个表中实现那些功能！代码如何改！？！原代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Row < 5 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
If Target.Value = "本月合计" Then
m = Target.Row - 1
i = Range("C" & m + 1).End(xlUp).Row
Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
Range("N" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*N$6:N" & i & ")")
Range("P" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*P$6:P" & i & ")")
ElseIf Target.Value = "本年累计" Then
n = Target.Row - 2
Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
Range("N" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*N$6:N" & n & ")")
Range("P" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*P$6:P" & n & ")")
End If
End Sub


如何把上边的代码与下边您给我的代码合并起来！！谢谢

Sub balance()
Dim i As Long
i = 8
Do While Range("G" & i) <> ""
    Select Case Range("G" & i)
        Case "过　次　页", "承　前　页", "本月合计", "本年累计"
            Range("L" & i).Value = Range("L" & (i - 1)).Value
        Case Else
            Range("L" & i).Value = Range("L" & (i - 1)).Value + Range("H" & i).Value - Range("J" & i).Value
    End Select
    i = i + 1
Loop
End Sub

Bernard_ye

ok_welcome 发表于 2011-11-17 23:31
你好！我想在附件里这个表中实现那些功能！代码如何改！？！原代码如下：

Private Sub Worksheet_ ...

请见附件。。。。。。

ok_welcome

Bernard_ye 发表于 2011-11-17 23:53
请见附件。。。。。。

学习了！谢谢！！！搞定！