利用VBA统计出D列各行的总数

ba3259878266

利用VBA统计出D列各行的总数  在对应的G列显示    谢谢各位老师帮忙

Qs18

Function SumNumbersInString(inputString As String) As Double
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
   
    ' 正则表达式模式，匹配所有数字
    regex.Pattern = "\d+(\.\d+)?" ' 匹配整数和小数
    regex.Global = True ' 匹配所有出现的数字
   
    Dim matches As Object
    Set matches = regex.Execute(inputString)
   
    Dim total As Double
    total = 0
   
    ' 遍历所有匹配的数字并累加
    Dim match As Object
    For Each match In matches
        total = total + CDbl(match.Value)
    Next match
   
    ' 返回总和
    SumNumbersInString = total
   
    ' 清理
    Set regex = Nothing
    Set matches = Nothing
End Function

Sub qs()
    Dim testString As String
With Sheet1
arr = .Range("d2:d" & .Cells(Rows.Count, "d").End(3).Row)
For i = 1 To UBound(arr)
    If arr(i, 1) <> Empty Then
    testString = arr(i, 1)
    ' 调用函数并显示结果
    Dim result As Double
    result = SumNumbersInString(testString)
    arr(i, 1) = result
    End If
Next
.Range("g2").Resize(UBound(arr)) = arr
End With
End Sub

Qs18

试试.........

Qs18

试试.........

今铭昔

ykcbf1100

参与一下，正则

sdytsxd991122

正则

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.3   正则统计
   
2.     Dim st As String
   
3.     r = Cells(Rows.Count, 4).End(3).Row
   
4.     arr = [d1].Resize(r, 1)
   
5.     For i = 2 To UBound(arr)
   
6.         Count = 0
   
7.         If arr(i, 1) <> Empty Then
   
8.             st = arr(i, 1)
   
9.             Count = Count + CountNumber(st)
   
10.             Cells(i, 7) = Count
    
11.         End If
    
12.     Next
    
13.     MsgBox "OK！"
    
14. End Sub
    
15. 
    
16. Function CountNumber(text As String) As Integer
    
17.     Set reg = CreateObject("VBScript.RegExp")
    
18.     With reg
    
19.         .Global = True
    
20.         .Pattern = "(\d+)"     '//统计字串中数量
    
21.         .IgnoreCase = True
    
22.     End With
    
23.     Count = 0
    
24.     Set mh = reg.Execute(text)
    
25.     For Each ma In mh
    
26.         Count = Count + Val(ma.SubMatches(0))  '//小计
    
27.     Next ma
    
28.     CountNumber = Count
    
29. End Function
    
30. 
    

复制代码

usedrange

1. Sub tt()
   
2.     Dim ar, i%, j%, m%, s, v%
   
3.     m = [d1000].End(xlUp).Row
   
4.     ar = Range("d2:d" & m)
   
5.     With CreateObject("vbscript.regexp")
   
6.         .Global = True
   
7.         .Pattern = "\d+"
   
8.         For i = 1 To UBound(ar)
   
9.             If ar(i, 1) <> "" Then
   
10.                 Set s = .Execute(ar(i, 1))
    
11.                 v = 0
    
12.                 For j = 0 To s.Count - 1
    
13.                     v = v + s(j)
    
14.                 Next j
    
15.                 Cells(i + 1, "g") = v
    
16.             End If
    
17.         Next i
    
18.     End With
    
19.     Set s = Nothing
    
20. End Sub
    

复制代码

杨建营

请楼主参考。