一个单元格提取多个数值并求和

方方格子

Option Explicit
Sub abc()
　Dim a, i, j, t
　a = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).Value
　ReDim b(1 To UBound(a), 1 To 1)
　For i = 1 To UBound(a)
　　If Len(a(i, 1)) Then
　　　t = Split(a(i, 1), vbLf)
　　　For j = 0 To UBound(t)
　　　　If InStr(t(j), "数量") Then b(i, 1) = b(i, 1) + Val(Split(t(j), "数量")(1))
　　　Next
　　End If
　Next
　[c1].Resize(UBound(b)) = b
End Sub

'这样还简单一点
Option Explicit
Sub abc()
　Dim a, i, j, t
　a = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).Value
　ReDim b(1 To UBound(a), 1 To 1)
　For i = 1 To UBound(a)
　　t = Split(a(i, 1), "数量")
　　If UBound(t) > 0 Then
　　　For j = 1 To UBound(t)
　　　　b(i, 1) = b(i, 1) + Val(t(j))
　　　Next
　　End If
　Next
　[c1].Resize(UBound(b)) = b
End Sub

Function abc(rng As Range) As Double
Dim c As Range
For Each c In rng
abc = abc + ccc(c)
Next
End Function
Function ccc(d)
Dim arr: arr = Split(d, vbLf)
Dim n%
For n = 0 To UBound(arr)
ccc = ccc + Split(arr(n), "数量")(1) * 1
Next
End Function