如图所示，请教一下各位高手

hezudao_long

希望写出达到这结果的VBA函数

kkf5560

=SUM(--TEXT(MID(B2,ROW($1:$99),1),"0;0;0;!0"))

hezudao_long

kkf5560 发表于 2020-6-30 16:17
=SUM(--TEXT(MID(B2,ROW($1:$99),1),"0;0;0;!0"))

感谢，但是这个公式不适用大于10以上的数字

kkf5560

1. Function sumNum(r As Range)
   
2.     Dim i&, str, num, door As Boolean, s
   
3.     For i = 1 To Len(r.Value)
   
4.         str = Mid(r.Value, i, 1)
   
5.         door = IIf(IsNumeric(str), True, False)
   
6.         If door = True Then
   
7.             num = num & str
   
8.         Else
   
9.             s = s * 1 + num * 1
   
10.             num = 0
    
11.         End If
    
12.     Next i
    
13.     sumNum = s + num
    
14. End Function
    

复制代码

any1009

感觉用正则把“[]”去掉就可以了，就是不会正则

lkqsmxw

Function GetChar(strChar As String, varType As Variant) '取值函数
   
    Dim objRegExp As Object
   
    Dim objMatch As Object
   
    Dim strPattern As String
   
    Dim arr, i, j, k
   
    Set objRegExp = CreateObject("vbscript.regexp")
   
    varType = LCase(varType)
   
    Select Case varType
        
    Case 1, "number"
        
        strPattern = "-?\d+(\.\d+)?"
        
    Case 2, "english"
        
        strPattern = "[a-z]+"
        
    Case 3, "chinese"
        
        strPattern = "[\u4e00-\u9fa5]+"
        
    End Select
   
    With objRegExp
        
        .Global = True
        
        .IgnoreCase = True
        
        .Pattern = strPattern
        
        Set objMatch = .Execute(strChar)
        
    End With
   
    If objMatch.count = 0 Then
        GetChar = ""
        Exit Function
    End If
   
    ReDim arr(0 To objMatch.count - 1)
    For Each cell In objMatch
        arr(i) = objMatch(i)
        i = i + 1
    Next
    k = ""
    For j = 0 To UBound(arr)
        If varType = 1 Then
           If k = "" Then k = Val(arr(j)) Else k = k + Val(arr(j))
        Else
           If k = "" Then k = arr(j) Else k = k & "," & arr(j)
        End If
    Next j
    GetChar = k
    Set objRegExp = Nothing
    Set objMatch = Nothing
End Function

232670631

Function abc(rng As Range) As Long
Dim t, i%
t = Split(rng, "+")
For i = 0 To UBound(t)
    If InStr(t(i), "[") Then
        t(i) = Split(t(i), "[")(0)
    End If
    abc = abc + t(i)
Next
End Function

hezudao_long

1. Sub test()
   
2. Dim I As Integer
   
3. For I = 2 To [A65536].End(xlUp).Row
   
4. If Cells(I, 2) <> "" Then
   
5. Cells(I, 6) = "=" & Replace(Replace(Cells(I, 2), "[", "+n("""), "]", """)")
   
6. End If
   
7. Next I
   
8. End Sub

复制代码

感谢几位的解答，对我帮助很大，我写了个过程，也实现了类似效果，供其他人参考