当具有可变分隔符时，VBA将字符串拆分为多个单元格答案

【问题标题】：VBA Splitting a String into multiple cells when it has variable Delimiters当具有可变分隔符时，VBA将字符串拆分为多个单元格
【发布时间】：2019-01-28 07:23:03
【问题描述】：

如果我将以下信息全部包含在一个单元格中，并且我想将其拆分为单独的单元格。我了解如何使用空格作为分隔符，但在这种情况下，名称也有空格，我希望名称一起留在一个单元格中。更复杂的是，名字并不总是只有名字和姓氏，它还可以包括中间，所以并不总是标准的两个名字。

2172571122  Jane Doe 3143332222 John Doe

2172242237 Mary Mixer 2223334444 Mike M Martin

希望它最终看起来像这样：

Cell 1 = 2172242237 
Cell 2 = Mary Mixer 
Cell 3 = 2223334444 
Cell 4 = Mike M Martin

有什么建议吗？

【问题讨论】：

标签： excel vba delimiter

【解决方案1】：

这个基于正则表达式的函数在数字和文本（单词）之间交替分割。

Option Explicit

Function customSplit(str As String, _
                     Optional ndx As Integer = 1) As Variant

    Static rgx As Object, cmat As Object

    Set rgx = CreateObject("VBScript.RegExp")

    With rgx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        If CBool(ndx Mod 2) Then
            .Pattern = "[0-9]{10}"
            ndx = (ndx + 1) \ 2
        Else
            .Pattern = "[A-Z]{1,9}\s[A-Z]{1,9}[\s[A-Z]{1,9}]?"
            ndx = ndx \ 2
        End If
        If .test(str) Then
            Set cmat = .Execute(str)
            If ndx <= cmat.Count Then
                customSplit = cmat.Item(ndx - 1)
            End If
        End If
    End With

End Function

【讨论】：

【解决方案2】：

你可以试试：

Option Explicit

Sub test()

    Dim strToSplit As String, strImport As String
    Dim arrwords As Variant
    Dim i As Long, counter As Long

    With ThisWorkbook.Worksheets("Sheet1")
        strToSplit = .Range("A1").Value
        arrwords = Split(strToSplit, " ")

        counter = 1

        For i = LBound(arrwords) To UBound(arrwords)

            If IsNumeric(arrwords(i)) = True Then
                strImport = arrwords(i)
                .Cells(3, counter).Value = strImport
                counter = counter + 1
            ElseIf Not IsNumeric(arrwords(i)) = True Then
                If Not IsNumeric(.Cells(3, counter - 1).Value) Then
                    strImport = .Cells(3, counter - 1) & " " & arrwords(i)
                    .Cells(3, counter - 1).Value = strImport
                    counter = counter
                Else
                    strImport = arrwords(i)
                    .Cells(3, counter).Value = strImport
                    counter = counter + 1
                End If
            End If

        Next

    End With

End Sub

结果如下所示：

【讨论】：

【解决方案3】：

我对您可以做什么有一些想法。

1) 读取一行

执行split(line, " ") 并循环遍历这些不合理，同时对每个拆分值执行isNumeric()。如果不是，则添加到字符串 Array() 并将标志设置为 true。

然后，如果不是数字，则期望另一个名称并将标志设置为 true。

2) 读一行。

然后，循环遍历每个执行isnumeric 的字符，如果没有，则将该字符添加到字符串 Array() 并设置标志直到再次isnumeric，等等......

我希望这能帮助你，或者至少能让你朝着正确的方向前进。

【讨论】：

【解决方案4】：

已发布的其他变体：

Sub ZZZ()
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim num$, cl As Range, data As Range, key, x
    Dim Result As Worksheet
    Set data = Range([A1], Cells(Rows.Count, "A").End(xlUp))
    For Each cl In data
        x = "": num = "":
        For Each x In Split(cl, " ")
            If IsNumeric(x) Then
                num = x
                dic.Add x, ""
            ElseIf x <> "" And num <> "" Then
                dic(num) = Trim(dic(num) & " " & x)
            End If
        Next x
    Next cl
    Set Result = Worksheets.Add
    With Result
        .Name = "Result " & Replace(Now, ":", "-")
        x = 1
        For Each key In dic
            .Cells(x, "A").Value2 = key
            .Cells(x, "B").Value2 = dic(key)
            x = x + 1
        Next key
        .Columns("A:B").AutoFit
    End With
End Sub

测试：

【讨论】：