excel 鼠标选中即在状态栏显示求和（可以是文本型数字或单元格内有非数字）

likeyouli

单元格内可以是文本型数字，或单元格内除了数字之外，还有非数字，也一样求和（如果单元格内有多个非连贯数字，仅限单元格内第一个连贯数字求和）。表格里自带的数据仅为测试用,可删除,但不能删除工作表。
  vba编写，会的大神不屑于看代码，不会的就算看了也许还会有疑问，我也没时间解释，所以就不公开代码了，最大求和16384个单元格，最大统计150万单元格，多了会太卡，，
    小东西，不登大雅之堂，故发在娱乐专区，保证无毒， 去掉后边的.txt即可，要求excel必须启用宏

su45

会不会影响复制—粘贴呢？

likeyouli

su45 发表于 2022-12-1 17:02
会不会影响复制—粘贴呢？

只是求和, 不会影响,,把表格里的数据删除换成你需要的数据即可,,但不要删除工作表
源码：

Public WithEvents ex As Excel.Application
Private Sub ex_SheetDeactivate(ByVal sh As Object)
ex.StatusBar = ""
End Sub
Private Sub ex_SheetSelectionChange(ByVal sh As Object, ByVal target As Range)
Dim tt, w, cc As Range, n, m, dd(), ff As Range
On Error GoTo 900
Application.StatusBar = "稍等，正在计算中......"
Application.EnableEvents = False '这句代码意义可重大了，难为我数天夜里睡不好觉，代码老是重复运行，模块里测试的好好的，到了
'selectionchange时就出问题，估计就是运行某些代码时触动了selectionchange，导致重复运行出错！！
If target.Columns.Count = Cells.Columns.Count And target.Rows.Count = Cells.Rows.Count Then
m = "1048576 * 16384"
GoTo 100 '本行代码防止选中整个表格时target.count溢出
End If
If target.Count = 1 Then Application.StatusBar = "所选单元格内容为：“" & target.Value & "”，共选中1个单元格。": GoTo 200
'本行代码target.count=1防止有筛选或隐藏时选中一个单元格报错。
m = target.SpecialCells(xlCellTypeVisible).Count
100:
Set cc = Intersect(target.SpecialCells(xlCellTypeVisible), sh.UsedRange)
If cc Is Nothing Then
ex.StatusBar = "没有选中任何非空区域......"
GoTo 200
Else
m1 = cc.Count
End If
'dd = Intersect(target.SpecialCells(xlCellTypeVisible), sh.UsedRange)当有不可见单元格（即处于筛选模式或有隐藏单元格时，无
'法一次性将这个单元格集合赋给数组，必须用下边的for each一个一个导入到数组。
For Each ff In cc
w = w + 1
ReDim Preserve dd(1 To w)
dd(w) = ff.Value
Next ff '经过实际测试，先把选中区域cc读取到一维数组，与下边直接for each tt in cc里，速度差不多。
Set regx = CreateObject("vbscript.regexp")
With regx
    .Global = True
    .Pattern = "\d+\.?\d*"
                For Each tt In dd
                DoEvents
                If .Test(tt) Then
                Set sj = .Execute(tt)
                    For Each x In sj
                     n = n + x * 1
                     If n > 2147483647 Then GoTo taida
                    Next x
                End If
               Next tt
End With
ex.StatusBar = "所选单元格求和为：" & n & "，共选中" & m & "个单元格，其中可用区域单元格为" & m1 & "个。": GoTo 200
taida: ex.StatusBar = "所选单元格求和为已大于21亿，超出计算范围，共选中" & m & "个单元格，其中可用区域单元格为" & m1 & "个。": GoTo 200
900: ex.StatusBar = "所选单元格求和出现错误，请检查单元格内是否存在错误公式，或重新选择单元格！"
200: Application.EnableEvents = True
End Sub
Private Sub Workbook_Open()
Set ex = Excel.Application
End Sub
-----------------------------------------------------------------------------------完美的分割线-----------------------------------------------------------
这样才算效率高：

Public WithEvents ex As Excel.Application
Private Sub ex_SheetDeactivate(ByVal sh As Object)
ex.StatusBar = ""
End Sub

Private Sub ex_SheetSelectionChange(ByVal sh As Object, ByVal target As Range)
Dim tt, w, cc As Range, n, m, dd(), ff As Range, arrData
On Error GoTo 900
Application.StatusBar = "稍等，正在计算中......"
Application.EnableEvents = False '这句代码意义可重大了，难为我数天夜里睡不好觉，代码老是重复运行，模块里测试的好好的，到了
'selectionchange时就出问题，估计就是运行某些代码时触动了selectionchange，导致重复运行出错！！
If target.Columns.Count = Cells.Columns.Count And target.Rows.Count = Cells.Rows.Count Then
m = "1048576 * 16384"
GoTo 100 '本行代码防止选中整个表格时target.count溢出
End If

If target.Count = 1 Then Application.StatusBar = "所选单元格内容为：“" & target.Value & "”，共选中1个单元格。": GoTo 200
'本行代码target.count=1防止有筛选或隐藏时选中一个单元格报错。

m = target.SpecialCells(xlCellTypeVisible).Count
100:
Set cc = Intersect(target.SpecialCells(xlCellTypeVisible), sh.UsedRange)
If cc Is Nothing Then
ex.StatusBar = "没有选中任何非空区域......"
GoTo 200
Else
m1 = cc.Count
End If

Set regx = CreateObject("vbscript.regexp")
With regx
    .Global = True
    .Pattern = "-?\d+\.?\d*"
    For Each areaRng In cc.Areas
    If areaRng.Cells.Count = 1 Then ' 将单单元格的值包装成 1行1列的二维数组
        ReDim arrData(1 To 1, 1 To 1)
        arrData(1, 1) = areaRng.Value
    Else
        arrData = areaRng.Value
    End If
        For i = 1 To UBound(arrData, 1)
            For j = 1 To UBound(arrData, 2)
                    If .Test(arrData(i, j)) Then
                        Set matches = .Execute(arrData(i, j))
                        For Each Match In matches
                            n = n + Match * 1
                            If n > 2147483647111# Then GoTo taida
                        Next Match
                    End If
            Next j
        Next i
    Next areaRng
End With

ex.StatusBar = "所选单元格求和为：" & n & "，共选中" & m & "个单元格，其中可用区域单元格为" & m1 & "个。": GoTo 200
taida: ex.StatusBar = "所选单元格求和为已大于21亿，超出计算范围，共选中" & m & "个单元格，其中可用区域单元格为" & m1 & "个。": GoTo 200
900: ex.StatusBar = "所选单元格求和出现错误，请检查单元格内是否存在错误公式，或重新选择单元格！"
200: Application.EnableEvents = True
End Sub

Private Sub Workbook_Open()
Set ex = Excel.Application
End Sub