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

Qs18

1. Sub 按钮1_Click()
   
2. Call qs
   
3. End Sub
   
4. Function SumNumbersInString(inputString As String) As Double
   
5.     Dim regex As Object
   
6.     Set regex = CreateObject("VBScript.RegExp")
   
7.    
   
8.     ' 正则表达式模式，匹配所有数字
   
9.     regex.Pattern = "\d+(\.\d+)?" ' 匹配整数和小数
   
10.     regex.Global = True ' 匹配所有出现的数字
    
11.    
    
12.     Dim matches As Object
    
13.     Set matches = regex.Execute(inputString)
    
14.    
    
15.     Dim total As Double
    
16.     total = 0
    
17.    
    
18.     ' 遍历所有匹配的数字并累加
    
19.     Dim match As Object
    
20.     For Each match In matches
    
21.         total = total + CDbl(match.Value)
    
22.     Next match
    
23.    
    
24.     ' 返回总和
    
25.     SumNumbersInString = total
    
26.    
    
27.     ' 清理
    
28.     Set regex = Nothing
    
29.     Set matches = Nothing
    
30. End Function
    
31. 
    
32. Sub qs()
    
33.     Dim testString As String
    
34. With Sheet3
    
35. arr = .Range("g3:g" & .Cells(Rows.Count, "g").End(3).Row)
    
36. For i = 1 To UBound(arr)
    
37.     If arr(i, 1) <> Empty Then
    
38.     testString = arr(i, 1)
    
39.     ' 调用函数并显示结果
    
40.     Dim result As Double
    
41.     result = SumNumbersInString(testString)
    
42.     arr(i, 1) = result
    
43.     End If
    
44. Next
    
45. .Range("h3").Resize(UBound(arr)).ClearContents
    
46. .Range("h3").Resize(UBound(arr), 1) = arr
    
47. End With
    
48. End Sub
    

复制代码

Qs18

再测试一下..........

Qs18

正则表达式匹配所有数字并求和

ba3259878266

Qs18 发表于 2024-9-4 07:05
正则表达式匹配所有数字并求和

老师谢谢 是这样的  因为G列数字会增加减少的  在重新计算时需要清除H列数字 重新显示  麻烦你了

G列空白时  H列也是空白

Qs18

ba3259878266 发表于 2024-9-4 08:58
老师谢谢 是这样的  因为G列数字会增加减少的  在重新计算时需要清除H列数字 重新显示  麻烦你了

G列 ...

没事，清空的范围尽量大一点就可以了

Qs18

1. Sub 按钮1_Click()
   
2. Call qs
   
3. End Sub
   
4. Function SumNumbersInString(inputString As String) As Double
   
5.     Dim regex As Object
   
6.     Set regex = CreateObject("VBScript.RegExp")
   
7.    
   
8.     ' 正则表达式模式，匹配所有数字
   
9.     regex.Pattern = "\d+(\.\d+)?" ' 匹配整数和小数
   
10.     regex.Global = True ' 匹配所有出现的数字
    
11.    
    
12.     Dim matches As Object
    
13.     Set matches = regex.Execute(inputString)
    
14.    
    
15.     Dim total As Double
    
16.     total = 0
    
17.    
    
18.     ' 遍历所有匹配的数字并累加
    
19.     Dim match As Object
    
20.     For Each match In matches
    
21.         total = total + CDbl(match.Value)
    
22.     Next match
    
23.    
    
24.     ' 返回总和
    
25.     SumNumbersInString = total
    
26.    
    
27.     ' 清理
    
28.     Set regex = Nothing
    
29.     Set matches = Nothing
    
30. End Function
    
31. 
    
32. Sub qs()
    
33.     Dim testString As String
    
34. With Sheet3
    
35. arr = .Range("g3:g" & .Cells(Rows.Count, "g").End(3).Row)
    
36. For i = 1 To UBound(arr)
    
37.     If arr(i, 1) <> Empty Then
    
38.     testString = arr(i, 1)
    
39.     ' 调用函数并显示结果
    
40.     Dim result As Double
    
41.     result = SumNumbersInString(testString)
    
42.     arr(i, 1) = result
    
43.     End If
    
44. Next
    
45. .Range("h3").Resize(65536, 1).ClearContents
    
46. .Range("h3").Resize(UBound(arr), 1) = arr
    
47. End With
    
48. End Sub
    

复制代码

Qs18

再试试看看.........

Qs18

再试试看..............

ba3259878266

Qs18 发表于 2024-9-4 10:19
再试试看..............

谢谢老师 麻烦你了  效果好  满意了 谢谢

ba3259878266

Qs18 发表于 2024-9-4 10:19
再试试看..............

老师 放到其它表格 还是出错 什么原因