遇空格向上加总

UCBEN

请教高手，用代码实现遇到空格时对上方的几个单元格进行加总，用ALT十=太慢了，谢谢！

有4地

选中定位-空白单元格然后用ALT十=。

UCBEN

有4地 发表于 2017-9-12 17:00
选中定位-空白单元格然后用ALT十=。

谢谢，这个就是有点慢，因资料太多，有几千行

有4地

UCBEN 发表于 2017-9-12 17:19
谢谢，这个就是有点慢，因资料太多，有几千行

这个还慢？

UCBEN

有4地 发表于 2017-9-12 17:45
这个还慢？

是的，要两三分钟，如果是VBA代码，应该快会很快

CC例例

供楼主参考：

1. Sub SumRng()
   
2.     Dim rng As Range, arA, iTem As Double, x&, y%
   
3.     On Error GoTo line
   
4.     Set rng = Application.InputBox("请使用鼠标选择单元格区域：", "选择单元格", , , , , , 8)
   
5.     If rng.Count > 1 And rng.SpecialCells(4).Count > 0 Then
   
6.         arA = rng.Value
   
7.         For y = 1 To UBound(arA, 2)
   
8.             For x = 1 To UBound(arA)
   
9.                 If Trim(arA(x, y)) <> "" Then
   
10.                     iTem = iTem + arA(x, y)
    
11.                 Else
    
12.                     arA(x, y) = iTem
    
13.                     iTem = 0
    
14.                 End If
    
15.             Next
    
16.         Next
    
17.         rng = arA
    
18.     End If
    
19. line:
    
20.     Set rng = Nothing
    
21. End Sub

复制代码

UCBEN

CC例例 发表于 2017-9-13 08:03
供楼主参考：

效果不错,感谢赐教! 还请帮忙完善一下,把代码直接作用于G,H,I,J 这4列到最后,因为几千行,每次都不确定行数.
感谢! 12345678.rar (12.22 KB, 下载次数: 11)

2017-9-13 22:58 上传

点击文件名下载附件

CC例例

1. Sub SumRng()
   
2.     Dim rng As Range, arA, iTem As Double, x&, y%
   
3.     Set rng = Range("g1:j" & Cells(Rows.Count, "g").End(3).Row).Offset(1)
   
4.     If rng.Count > 1 And rng.SpecialCells(4).Count > 0 Then
   
5.         arA = rng.Value
   
6.         For y = 1 To UBound(arA, 2)
   
7.             For x = 1 To UBound(arA)
   
8.                 If Trim(arA(x, y)) <> "" Then
   
9.                     iTem = iTem + arA(x, y)
   
10.                 Else
    
11.                     arA(x, y) = iTem
    
12.                     iTem = 0
    
13.                 End If
    
14.             Next
    
15.         Next
    
16.         rng = arA
    
17.     End If
    
18.     Set rng = Nothing
    
19. End Sub

复制代码

CC例例

楼上代码运行时，如果区域没空单元格，就会出错。重新更改一下。

1. Sub SumRng()
   
2.     Dim rng As Range, arA, iTem As Double, x&, y%
   
3.     Set rng = Range("g1:j" & Cells(Rows.Count, "g").End(3).Row)
   
4.     If rng.Count > 1 And Application.CountA(rng) < rng.Count Then
   
5.         arA = rng.Offset(1).Value
   
6.         For y = 1 To UBound(arA, 2)
   
7.             For x = 1 To UBound(arA)
   
8.                 If Trim(arA(x, y)) <> "" Then
   
9.                     iTem = iTem + arA(x, y)
   
10.                 Else
    
11.                     arA(x, y) = iTem
    
12.                     iTem = 0
    
13.                 End If
    
14.             Next
    
15.         Next
    
16.         rng.Offset(1) = arA
    
17.     End If
    
18.     Set rng = Nothing
    
19. End Sub

复制代码

UCBEN

对不起!这两天太忙，没有及时验证，你的代码一级棒，几千行若干空格能在瞬间完成遇空格向上加总，相当给力，学习了，收藏了，感谢赐教