智能添加边框代码优化

dssrmyh

优化代码，表内有说明，谢谢！

dssrmyh

顶上，别沉

蓝桥玄霜

请见代码。

1. Sub 删除加粗行()
   
2. Dim Arr, i&
   
3.     Application.ScreenUpdating = False
   
4.     With ActiveSheet
   
5.         Arr = .[a1].CurrentRegion
   
6.         For i = UBound(Arr) - 3 To 3 Step -1
   
7.             If Len(Arr(i, 2)) = 0 Then .Rows(i).Delete
   
8.         Next
   
9.     End With
   
10.     Arr = [a1].CurrentRegion
    
11.     For i = 2 To UBound(Arr) Step 32
    
12.         Cells(i, 1).Resize(1, 17).Select
    
13.         With Selection.Borders(xlEdgeBottom)
    
14.             .LineStyle = xlContinuous
    
15.             .Color = -1003520
    
16.             .Weight = xlMedium
    
17.         End With
    
18.     Next
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

dssrmyh

蓝桥玄霜 发表于 2018-9-21 14:32
请见代码。

谢谢，很完美了，但还有一点就是汇总行没有达到最终效果。

dssrmyh

蓝桥玄霜 发表于 2018-9-21 14:32
请见代码。

还有就是新插入一行后在运行代码，就没有删除之前的边框
也就是先清除之前的框线，再重新每隔32行添加加粗横线，谢谢！

不知道为什么

dssrmyh 发表于 2018-9-21 14:43
还有就是新插入一行后在运行代码，就没有删除之前的边框
也就是先清除之前的框线，再重新每隔32行添加加 ...

在版主的代码上根据自己的需要优化就可以了，实在不明白，自己可以通过录制宏！

dssrmyh

蓝桥玄霜 发表于 2018-9-21 14:32
请见代码。

请大师抽空再优化一下本代码以达到以下要求：
新插入一行或删除一行后在运行代码，没有删除之前添加的加粗横线；
汇总行没有添加上加粗横线，使之汇总行上下都添加加粗横线。

dssrmyh

不知道为什么 发表于 2018-9-21 14:56
在版主的代码上根据自己的需要优化就可以了，实在不明白，自己可以通过录制宏！

能抽空优化一下吗？我之前的代码就是录制的宏