讨教插行

xing_chen

于箱长 发表于 2022-11-24 15:38
不论多耗时间也比做重复劳动值得，学会了72般变化，你就想变啥变啥了

谢谢！有道理！大脑是用来思考的，不是机器用于重复劳动的。

袁勇

完善一下上面老师的代码：

1. Private Sub CommandButton1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Dim x, i, j As Integer
   
4.     Dim hj(1 To 5)
   
5.     For x = 2 To Range("b65536").End(xlUp).Row  '删除小计行
   
6.         If Cells(x, 2) = "小计" Then
   
7.             Rows(x).Delete   'Cells(x, 1).EntireRow.Delete
   
8.         End If
   
9.     Next
   
10. 
    
11.     Columns("a:h").Sort key1:=[b1], order1:=1, Header:=xlYes  '排序
    
12.     i = 2  '初始值i
    
13.     Do
    
14.         If Cells(i, 2) = Cells(i + 1, 2) Then   'B列上下行内容相同时，分别对D~H列单元格累计
    
15.             For j = 1 To 5
    
16.                 hj(j) = hj(j) + Cells(i, j + 3)
    
17.             Next
    
18.             i = i + 1
    
19.         Else                                    '否则，在下1行插入一空行
    
20.             For j = 1 To 5
    
21.                 hj(j) = hj(j) + Cells(i, j + 3)
    
22.             Next
    
23.             Cells(i + 1, 1).EntireRow.Insert    '在下1行插入一空行
    
24.             Cells(i + 1, 2) = "小计"            'B列单元格="小计"
    
25.             For j = 1 To 5
    
26.                 Cells(i + 1, j + 3) = hj(j)     '把合计值赋予小计行的单元格
    
27.             Next
    
28.             Cells(i + 1, 1).Resize(1, 8).Interior.ColorIndex = 6  '底色标黄
    
29.             i = i + 2
    
30.             For j = 1 To 5
    
31.                 hj(j) = 0
    
32.             Next
    
33.         End If
    
34.     Loop While Cells(i, 4) <> ""
    
35.     Application.ScreenUpdating = True
    
36.     [a1].CurrentRegion.Borders.LineStyle = 1
    
37. End Sub

复制代码

xing_chen

袁勇 发表于 2022-11-24 17:09
完善一下上面老师的代码：

谢谢老师！运行如愿