[已解决]流水账表格

zhgghw

想得到的结果有点复杂，详见附件。 附件明细账.rar (6.37 KB, 下载次数: 27)

2015-7-5 13:41 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

wp8680

2015-7-5 17:22

1. Sub 刷新()
   
2.     Dim ir%, m%, imax%
   
3.     Dim mx1#, mx2#, x#, sx1#, sx2#
   
4.     imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
   
5.     ir = 6
   
6.     x = Range("i5").Value
   
7. 
   
8.     Do
   
9.         If Range("a" & ir) <> "" Then
   
10.             mx1 = mx1 + Range("f" & ir)
    
11.             mx2 = mx2 + Range("g" & ir)
    
12.             sx1 = sx1 + Range("f" & ir)
    
13.             sx2 = sx2 + Range("g" & ir)
    
14.         End If
    
15.         Do
    
16.             m = Range("a" & ir)
    
17.             ir = ir + 1
    
18.             If Range("a" & ir) <> "" Then
    
19.                 mx1 = mx1 + Range("f" & ir)
    
20.                 mx2 = mx2 + Range("g" & ir)
    
21.                 sx1 = sx1 + Range("f" & ir)
    
22.                 sx2 = sx2 + Range("g" & ir)
    
23.             End If
    
24.              imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
    
25.             If (m <> Range("a" & ir + 1) And Range("a" & ir + 1) <> "") Or ir >= imax Then Exit Do
    
26.         Loop
    
27.         If Range("e" & ir) <> "累计" Then
    
28.             Range("e" & ir + 1).EntireRow.Insert
    
29.             Range("e" & ir + 1).EntireRow.Insert
    
30.             Else
    
31.             ir = ir - 2
    
32.         End If
    
33.         ir = ir + 1
    
34.         Range("e" & ir) = "本月合计"
    
35.         Range("f" & ir) = mx1
    
36.         Range("g" & ir) = mx2
    
37.         Range("i" & ir - 1) = x + sx1 - sx2
    
38.         ir = ir + 1
    
39.         Range("e" & ir) = "累计"
    
40.         Range("f" & ir) = sx1
    
41.         Range("g" & ir) = sx2
    
42.         mx1 = 0: mx2 = 0
    
43.         ir = ir + 1
    
44.          imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
    
45.         If ir >= imax Then Exit Do
    
46.     Loop
    
47. 
    
48. End Sub
    

复制代码

跳转到最佳答案楼层

qh8600

自动小计合计，可以用VBA

wp8680

1. Sub 刷新()
   
2.     Dim ir%, m%, imax%
   
3.     Dim mx1#, mx2#, x#, sx1#, sx2#
   
4.     imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
   
5.     ir = 6
   
6.     x = Range("i5").Value
   
7. 
   
8.     Do
   
9.         If Range("a" & ir) <> "" Then
   
10.             mx1 = mx1 + Range("f" & ir)
    
11.             mx2 = mx2 + Range("g" & ir)
    
12.             sx1 = sx1 + Range("f" & ir)
    
13.             sx2 = sx2 + Range("g" & ir)
    
14.         End If
    
15.         Do
    
16.             m = Range("a" & ir)
    
17.             ir = ir + 1
    
18.             If Range("a" & ir) <> "" Then
    
19.                 mx1 = mx1 + Range("f" & ir)
    
20.                 mx2 = mx2 + Range("g" & ir)
    
21.                 sx1 = sx1 + Range("f" & ir)
    
22.                 sx2 = sx2 + Range("g" & ir)
    
23.             End If
    
24.              imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
    
25.             If (m <> Range("a" & ir + 1) And Range("a" & ir + 1) <> "") Or ir >= imax Then Exit Do
    
26.         Loop
    
27.         If Range("e" & ir) <> "累计" Then
    
28.             Range("e" & ir + 1).EntireRow.Insert
    
29.             Range("e" & ir + 1).EntireRow.Insert
    
30.             Else
    
31.             ir = ir - 2
    
32.         End If
    
33.         ir = ir + 1
    
34.         Range("e" & ir) = "本月合计"
    
35.         Range("f" & ir) = mx1
    
36.         Range("g" & ir) = mx2
    
37.         Range("i" & ir - 1) = x + sx1 - sx2
    
38.         ir = ir + 1
    
39.         Range("e" & ir) = "累计"
    
40.         Range("f" & ir) = sx1
    
41.         Range("g" & ir) = sx2
    
42.         mx1 = 0: mx2 = 0
    
43.         ir = ir + 1
    
44.          imax = Range("e" & Cells.Rows.Count).End(xlUp).Row
    
45.         If ir >= imax Then Exit Do
    
46.     Loop
    
47. 
    
48. End Sub
    

复制代码

wp8680

注意刷新后，如果需要添加本月数据的，要把最后二行的小计删除后再添加。
如果添加下月数据则不受影响，可以多次刷新。

zhgghw

wp8680 发表于 2015-7-5 17:22

很好的VBA工程，如果在“本月合计”所在行的下边从A到I 划上一条红色边框线就更完美了。谢谢！

wp8680

zhgghw 发表于 2015-7-11 17:19
很好的VBA工程，如果在“本月合计”所在行的下边从A到I 划上一条红色边框线就更完美了。谢谢！

你贪心不？可以用也不给最佳。那红线仅是一句代码就可以的事。

zhgghw

wp8680 发表于 2015-7-11 19:12
你贪心不？可以用也不给最佳。那红线仅是一句代码就可以的事。

这阵工作有点忙，这才来设最佳。只要是好的，啥时候设都不算晚哈。