I'；我想写VBA脚本，将单个Excel单元格中的文本分隔为多个单元格

我有一长串的出版物，所有的数据都放在一个单元格里。我想把每个单元格中的数据分成不同的列。作者、职称、年份、期刊、日期等各一份

例如，在一个单元格中，我有：

Plant RA、Page JP、Bonham JH、Jones JP《通往天堂的阶梯》（1971年）于12月5日由泽普林领导；1（39）：14802-14084

姓名代表作者，天梯代表头衔（1971年），杂志名称以泽普林为首，12月5日为日期，1（39）日为发行日期，14802-14804年至今

尽管每次引用的篇幅、作者数量等都会有所不同，但是否有可能实现这一过程的自动化？对于一些基于

LEFT（B1，SEARCH（“，B1）-1）

之类的命令，变量太多了，但我忍不住觉得这一定是人们经常遇到的问题。一个简单的解决方案可能吗

---

提前感谢。

好吧，这取决于引用格式的变化程度，但自动化复杂字符串处理的一个非常有用的工具是。下面的一些代码演示了如何构建一个可能的解决方案。“Test（）”子例程将演示该过程

---

当然，这取决于引用格式的变化程度，但自动化复杂字符串处理的一个非常有用的工具是。下面的一些代码演示了如何构建一个可能的解决方案。“Test（）”子例程将演示该过程

---

您的字符串似乎没有恒定变量，例如每个部分都以

结尾，

是否可以创建该变量？否则，似乎有很多变量，正如你所说的，每个字符串的长度和结构都不一样，这就是我害怕的。我想我可以在每个部分之间插入类似于

和
的内容，并可能使该过程自动化。如果是这样的话，脚本会是什么样子？我不需要基于字符数进行测量，我可以把从△到△的一切都拉出来吗？为了自动化这个过程，你可以回到我刚才提到的同一个问题。字符串是否仅在Excel工作表中，还是您首先从其他地方检索到的？它是从其他地方检索到的。数据来自一项调查，因此用户自己将字符串输入到单个列中。当然，让它们分隔输入上的数据更有意义……如果您有一致的列分隔符，那么您可以使用Split函数分割字符串。请看，您的字符串似乎没有一致的变量，例如每个部分都以
结尾，
是否可以创建该变量？否则，似乎有很多变量，正如你所说的，每个字符串的长度和结构都不一样，这就是我害怕的。我想我可以在每个部分之间插入类似于
和
的内容，并可能使该过程自动化。如果是这样的话，脚本会是什么样子？我不需要基于字符数进行测量，我可以把从△到△的一切都拉出来吗？为了自动化这个过程，你可以回到我刚才提到的同一个问题。字符串是否仅在Excel工作表中，还是您首先从其他地方检索到的？它是从其他地方检索到的。数据来自一项调查，因此用户自己将字符串输入到单个列中。当然，让它们分隔输入上的数据更有意义……如果您有一致的列分隔符，那么您可以使用Split函数分割字符串。看见
Sub Test()
    Dim s(1 To 3) As String
    'Format A
    s(1) = "Plant RA, Page JP, Bonham JH, Jones JP Stairway to Heaven (1971) Led Zepplin Dec 5;1(39):14802-14084"
    'Format B
    s(2) = "Plant RA, Page JP, Bonham JH, Jones JP Stairway to Heaven [1971] Led Zepplin Dec 5;1(39):14802-14084"
    'Unknown Format
    s(3) = "Plant RA, Page JP, Bonham JH, Jones JP Stairway to Heaven (1971) Led Zepplin Dec 5-1(39):14802-14084"

    test_string = s(1)

    MsgBox GetFormat(test_string) & Chr(10) & GetYear(test_string)
End Sub
Function GetYear(ByVal s As String)
    Dim YearPattern As Object
    Set YearPattern = CreateObject("Scripting.Dictionary")
    YearPattern.Add "FormatA", "\(\d{4}\)"
    YearPattern.Add "FormatB", "\[\d{4}\]"

    F = GetFormat(s)
    If F = "Unknown Format" Then
        GetYear = "Error: Format not recognized"
    Else
        Set Result = FindPattern(s, YearPattern(F))
        n = Result.Count
        If n = 0 Then
            GetYear = "![No Result]"
        ElseIf n = 1 Then
            GetYear = Result(0)
        Else
            GetYear = "![Multiple results]: "
            For Each r In Result
                GetYear = GetYear & ", " & r
            Next
        End If
        GetYear = Clean(GetYear, CType)
    End If
End Function
Function GetFormat(ByVal s As String)
    Set FormatPatterns = CreateObject("Scripting.Dictionary")
    FormatPatterns.Add "FormatA", ",+.*\(\d{4}\).*;.*\):"
    FormatPatterns.Add "FormatB", ",+.*\[\d{4}\].*;.*\):"

    If FindPattern(s, FormatPatterns("FormatA")).Count > 0 Then
        GetFormat = "FormatA"
    ElseIf FindPattern(s, FormatPatterns("FormatB")).Count > 0 Then
        GetFormat = "FormatB"
    Else
        GetFormat = "Unknown Format"
    End If
End Function
Function FindPattern(ByVal s As String, ByVal p As String) As Variant
    'Argument 1: The string to execute regular expressions on (s)
    'Argument 2: A pattern string to execute (p)
    'Return Value: An array of regular expression results
    Set r = CreateObject("vbscript.regexp")
    r.Global = True
    r.IgnoreCase = True
    r.MultiLine = True
    r.Pattern = p
    Set FindPattern = r.Execute(s)
End Function
Function Clean(ByVal s As String, Optional ByVal CType As String) As String
    'Removes unwanted characters from a string (s)
    'Based on the specified type of string "CType"
    Select Case CType
    Case "Year"
        Clean = Replace(Replace(Replace(s, "(", ""), ")", ""), ": ,", ": ")
    Case Else
        Clean = Replace(s, ": ,", ": ")
    End Select
End Function