表格选区求和问题

leedun

下面是自动求和的代码，如果选择两个不连续区域，只能对最后一次选区单元格数据进行求和，求各位前辈看看怎么能实现对所有选区的单元格进行计算，谢谢！

Sub 表格选区单元格求和()
    Dim oRng As Range, C As Cell, oTable As Table, dSum As Double
    Dim sCellValue, arr(), i, j
    On Error Resume Next
    With Selection
        For Each C In .Cells
            sCellValue = C.Range.Text '把单元格结尾字符去掉
            sCellValue = VBA.Replace(sCellValue, Chr(13) & Chr(7), "") '判断单元格内容是否是数值
            If VBA.IsNumeric(sCellValue) Then
                ReDim Preserve arr(i)
                arr(i) = sCellValue
                dSum = dSum + arr(i)
                i = i + 1
            End If
        Next
    End With
    MsgBox "选择的数据是：" & Join(arr, " ") & vbCrLf & "共" & i & "个数据" & vbCrLf & "求和结果为：" & dSum
End Sub

413191246se

1. Sub CellSum()
   
2.     Dim c As Cell, s$, t&
   
3.     With Selection
   
4.         If Not .Information(12) Then MsgBox "Out-Table!", 0 + 16: End
   
5.         If .Type = wdSelectionIP Then MsgBox "Not-Select!", 0 + 16: End
   
6.         .Tables(1).Range.Underline = wdUnderlineNone
   
7.         .Font.Underline = wdUnderlineSingle
   
8.         .HomeKey
   
9.         For Each c In .Tables(1).Range.Cells
   
10.             If c.Range.Underline = wdUnderlineSingle Then
    
11.                 c.Range.Underline = wdUnderlineNone
    
12.                 s = c.Range.Text
    
13.                 s = Replace(s, vbCr, "")
    
14.                 s = Replace(s, Chr(7), "")
    
15.                 t = t + s
    
16.             End If
    
17.         Next
    
18.     End With
    
19.     MsgBox "CellSum = " & t
    
20. End Sub

复制代码

leedun

413191246se 发表于 2021-1-9 01:19

感谢前辈深夜解答，如果表格数据本身有下划线的话就影响原来格式，再就是计算过程是对整个表格数据循环查找标注的数据，如果数据太多会不会影响运行速度？

413191246se

楼主，是会影响运行速度。因为程序要在所有单元格内循环，来判断每个单元格内数据是否是刚才选定的（判断依据是下划线，其实用颜色也可以；总之，是要有一个特征以区别于别的未选定的单元格），再累加。如果数据太多，只能是耐心等待。目前，我看 VBA 宏对付大文档、多表格有点儿无能为力，比较尴尬。

leedun

413191246se 发表于 2021-1-9 11:37
楼主，是会影响运行速度。因为程序要在所有单元格内循环，来判断每个单元格内数据是否是刚才选定的（判断依 ...

感谢前辈悉心解答，也期待有有其他的好方法！