如何用vba将试卷题目和选项分开？

比如单元格中有一列试卷的题目和选项，其中每道题的题目和选项在一个单元格中，形式如下:

序号+分隔符+题目内容+A+分隔符+A选项内容+B+分隔符+B选项内容+C+分隔符+C选项内容+D+分隔符+D选项内容

要将上述的内容按照 题目内容+A选项内容+B选项内容+C选项内容+D选项内容 的形式分别拆分到不同的单元格

可以使用如下的思路：

1.首先确定各个选项后面的分隔符是否统一，如果统一获取该分隔符。

2.用正则表达式将 选项+分隔符 替换为一个不可能存在于题目内容和选项内容中的字符。

3.用split函数拆分步骤2替换后的字符生成数组，然后依次填入具体的单元格中。

代码如下：

Sub QQ1722187970()
    Dim oRegExp As Object
    Set oRegExp = CreateObject("vbscript.regexp")
    Dim oDic As Object
    Set oDic = CreateObject("Scripting.Dictionary")
    Dim oWK As Worksheet
    Set oWK = Sheet1
    Dim arr(0 To 10, 0 To 10)
    With oRegExp
        '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
        .Global = True
        '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
        .IgnoreCase = True
        With oWK
            For i = 1 To 10
                sText = .Cells(i, "a")
                n = 0
                With oRegExp
                    .Pattern = "[a-d|A-D]([^a-z|^A-Z])"
                    '判断是否可以找到匹配的字符，若可以则返回True
                    If .test(sText) Then
                        '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
                        Set oMatches = .Execute(sText)
                        For Each oMatch In oMatches
                            '判断A\B\C\D选项后面的分隔符是什么字符
                            sResult = oMatch.SubMatches(0)
                            With oDic
                                If .exists(sResult) Then
                                    .Item(sResult) = .Item(sResult) + 1
                                Else
                                    .Add sResult, n
                                End If
                            End With
                        Next
                        arrKeys = oDic.keys
                        arrItems = oDic.items
                        '获取分隔符
                        sFGF = Excel.Application.WorksheetFunction.Index(arrKeys, Excel.Application.WorksheetFunction.Match(Excel.WorksheetFunction.Max(arrItems), arrItems, 0))
                        .Pattern = "[a-d|A-D]" & "\" & sFGF
                        sText = .Replace(sText, Chr(13))
                        arr = Split(sText, Chr(13))
                        With oWK
                            '题目
                            .Cells(i, "b") = arr(0)
                            '选项A
                            .Cells(i, "C") = arr(1)
                            '选项B
                            .Cells(i, "D") = arr(2)
                            '选项C
                            .Cells(i, "E") = arr(3)
                            '选项D
                            .Cells(i, "F") = arr(4)
                        End With
                    End If
                End With
            Next i
        End With
    End With
End Sub