将数字串拆分为单个单元格，包括括号/方括号内的数字

Question

我有一列，其中每个单元格都有一串数字，，-，括号/方括号/花括号中的数字。下面是一个很好的例子：

3？？？0{1012}？121-2[101]--01221111(01)1

如何将字符串按字符分成不同的单元格，在这种情况下，字符是指括号/括号/大括号（包括所述括号/括号/大括号）中的任何数字, ?, -, 和值？

本质上，上面的字符串将变成以下内容（间隔开来表示一个单独的单元格）：

3？0 {1012} ? 1 2 1-2[101]-0 1 2 1（01）1

括号/方括号/花括号内的数字数量各不相同。任何字符串中都没有字母。

Answer 1

假设数据在A列中，从第1行开始，并且您希望结果从B列开始，并且在A列中的每一行数据都是正确的，这里有一种仅使用工作表公式的替代方法。

在单元格B1中，使用以下公式：

=IF(OR(LEFT(A1,1)={"(","[","{"}),LEFT(A1,MIN(FIND({")","]","}"},A1&")]}"))),IFERROR(--LEFT(A1,1),LEFT(A1,1)))

在单元格C1中，使用以下公式：

=IF(OR(MID($A1,SUMPRODUCT(LEN($B1:B1))+1,1)={"(","[","{"}),MID($A1,SUMPRODUCT(LEN($B1:B1))+1,MIN(FIND({")","]","}"},$A1&")]}",SUMPRODUCT(LEN($B1:B1))+1))-SUMPRODUCT(LEN($B1:B1))),IFERROR(--MID($A1,SUMPRODUCT(LEN($B1:B1))+1,1),MID($A1,SUMPRODUCT(LEN($B1:B1))+1,1)))

向右复制C1公式，直到它开始为您提供空格（A单元格中的字符串中没有其他项目可拆分）。在您的示例中，需要将其复制到AA列。然后，您可以为列A数据的其余部分复制公式。

Answer 2

还有别的东西要看：）

Sub test()

    'String to parse through
    Dim aStr As String
    'final string to print
    Dim finalString As String

    aStr = "3????0{1012}?121-2[101]--01221111(01)1"

    'Loop through string
    For i = 1 To Len(aStr)
        'The character to look at
        char = Mid(aStr, i, 1)
        'Check if the character is an opening brace, curly brace, or parenthesis
        Dim result As String
        Select Case char

            Case "["
                result = loop_until_end(Mid(aStr, i + 1), "]")
                i = i + Len(result)
                result = char & result

            Case "("
                result = loop_until_end(Mid(aStr, i + 1), ")")
                i = i + Len(result)
                result = char & result

            Case "{"
                result = loop_until_end(Mid(aStr, i + 1), "}")
                i = i + Len(result)
                result = char & result

            Case Else
                result = Mid(aStr, i, 1)

        End Select
        finalString = finalString & result & " "
    Next
    Debug.Print (finalString)
End Sub
'Loops through and concatenate to a final string until the end_char is found
'Returns a substring starting from the character after
Function loop_until_end(aStr, end_char)
    idx = 1
    If (Len(aStr) <= 1) Then
        loop_until_end = aStr
    Else
        char = Mid(aStr, idx, 1)
        Do Until (char = end_char)
            idx = idx + 1
            char = Mid(aStr, idx, 1)
        Loop
    End If
    loop_until_end = Mid(aStr, 1, idx)
End Function

Answer 3

你在这里！

正则表达式方法：

Sub Test_RegEx()
    Dim s, col, m
    s = "3????0{1012}?121-2[101]--01221111(01)1"
    Set col = CreateObject("Scripting.Dictionary")
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(?:\d|-|\?|\(\d+\)|\[\d+\]|\{\d+\})"
        For Each m In .Execute(s)
            col(col.Count) = m
        Next
    End With
    MsgBox Join(col.items) ' 3 ? ? ? ? 0 {1012} ? 1 2 1 - 2 [101] - - 0 1 2 2 1 1 1 1 (01) 1
End Sub

循环方法：

Sub Test_Loop()
    Dim s, col, q, t, k, i
    s = "3????0{1012}?121-2[101]--01221111(01)1"
    Set col = CreateObject("Scripting.Dictionary")
    q = "_"
    t = True
    k = 0
    For i = 1 To Len(s)
        t = (t Or InStr(1, ")]}", q) > 0) And InStr(1, "([{", q) = 0
        q = Mid(s, i, 1)
        If t Then k = k + 1
        col(k) = col(k) & q
    Next
    MsgBox Join(col.items) ' 3 ? ? ? ? 0 {1012} ? 1 2 1 - 2 [101] - - 0 1 2 2 1 1 1 1 (01) 1
End Sub