请帮助修改代码的问题

新时代新征途

老师们好！我想解决的问题在附件里面有说明。谢谢！





                        修改代码.zip (67.38 KB, 下载次数: 9)

2018-8-19 13:44 上传

点击文件名下载附件

蓝桥玄霜

1. Sub 删除小计和合计()
   
2.   Sheet2.Activate
   
3.   Dim rng As Range, i&, r&
   
4.   r = Cells(Rows.Count, 1).End(3).Row
   
5.   If Cells(r, 2) <> "合计" Then Exit Sub
   
6.   Set rng = Rows(r - 1)
   
7.   For i = 6 To r
   
8.     If InStr(Cells(i, 2), "计") > 0 Then
   
9.       Set rng = Union(rng, Rows(i))
   
10.     End If
    
11.   Next
    
12.   rng.EntireRow.Delete
    
13. End Sub
    
14. 
    
15. Sub 插入小计和合计()
    
16.   Application.ScreenUpdating = False
    
17.   Sheet2.Activate
    
18.   Dim rng As Range, c, i&, k&, r&
    
19.   r = Cells(Rows.Count, 1).End(3).Row
    
20.   If Cells(r, 2) = "合计" Then Exit Sub
    
21.   Cells(r + 2, 2) = "合计"
    
22.   Cells(r + 2, 1) = r - 5 & "笔"
    
23.   Cells(r + 1, 1).Resize(2, 20).Borders.LineStyle = 1
    
24.   Cells(r + 2, 1).Resize(1, 20).Interior.ColorIndex = 40
    
25.   k = 1
    
26.   For i = 7 To r * 2
    
27.     If Cells(i, 2) = "合计" Then Exit For
    
28.     If Left(Cells(i, 1), 3) = Left(Cells(i - 1, 1), 3) Then
    
29.       k = k + 1
    
30.     Else
    
31.       Rows(i).Insert
    
32.       r = r + 1
    
33.       Cells(i, 2) = "小计"
    
34.       Cells(i, 1) = k & "笔"
    
35.       For Each c In Array(7, 14, 15)
    
36.         Cells(i, c) = Application.Sum(Cells(i - k, c).Resize(k))
    
37.         Cells(r + 2, c) = Cells(r + 2, c) + Cells(i, c)
    
38.       Next
    
39.       Cells(i, 1).Resize(1, 20).Interior.ColorIndex = 35
    
40.       k = 1: i = i + 1
    
41.     End If
    
42.   Next
    
43.   Application.ScreenUpdating = True
    
44. End Sub
    

复制代码

新时代新征途

蓝桥玄霜 发表于 2018-8-19 14:57

谢谢蓝版主的帮助！