[已解决]运用宏代码快速输入不规格求和公式

席可茵

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-4-15 12:44

增加了一句，减少循环。

1. Sub aaa()
   
2. Dim i&, k&, s$, r&
   
3. s = [a1]
   
4. r = [a65536].End(3).Row
   
5. Application.ScreenUpdating = False
   
6. For i = 4 To r
   
7.   If Cells(i, 1) = s Then
   
8.     For k = i To r
   
9.       If Cells(k, 1) = "" Then Exit For
   
10.     Next k
    
11.     Cells(i, 12) = "=SUM(K" & i & ":K" & k - 1 & ")"
    
12.   End If
    
13.   i = k
    
14. Next i
    
15. Application.ScreenUpdating = True
    
16. End Sub

复制代码

跳转到最佳答案楼层

席可茵

附件

大灰狼1976

1. Sub aaa()
   
2. Dim i&, k&, s$, r&
   
3. s = [a1]
   
4. r = [a65536].End(3).Row
   
5. Application.ScreenUpdating = False
   
6. For i = 4 To r
   
7.   If Cells(i, 1) = s Then
   
8.     For k = i To r
   
9.       If Cells(k, 1) = "" Then Exit For
   
10.     Next k
    
11.     Cells(i, 12) = "=SUM(K" & i & ":K" & k - 1 & ")"
    
12.   End If
    
13. Next i
    
14. Application.ScreenUpdating = True
    
15. End Sub

复制代码

大灰狼1976

增加了一句，减少循环。

1. Sub aaa()
   
2. Dim i&, k&, s$, r&
   
3. s = [a1]
   
4. r = [a65536].End(3).Row
   
5. Application.ScreenUpdating = False
   
6. For i = 4 To r
   
7.   If Cells(i, 1) = s Then
   
8.     For k = i To r
   
9.       If Cells(k, 1) = "" Then Exit For
   
10.     Next k
    
11.     Cells(i, 12) = "=SUM(K" & i & ":K" & k - 1 & ")"
    
12.   End If
    
13.   i = k
    
14. Next i
    
15. Application.ScreenUpdating = True
    
16. End Sub

复制代码

大灰狼1976

附件

席可茵

大灰狼1976 发表于 2017-4-15 12:44
增加了一句，减少循环。

谢谢，感谢你的帮助，很实用！