Excel将文本提取到列中

是否有一种方法可以从单个单元格中提取数据并按标题将其拆分为列。例如，我们在A1单元格中有如下文本：

Name: John
Address: USA, New York
Age: 66

---

我想将此文本拆分为标题为Name、Address、Age的列，并将数据提取到以下列。如果您不介意使用公式而不是VBA，我将非常感谢您的提示。

：

使用Excel O365：

B2中的公式：

使用Excel 2013或更高版本（O365除外）：

=INDEX(TRIM(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE($A2,":",CHAR(10)),CHAR(10),"</s><s>")&"</s></t>","//s[position() mod 2 = 0]")),COLUMN(A1))

---

然后上下拖动…

这有点棘手，但可以在所有版本的excel上使用。根据下面的屏幕截图，将姓名、地址、年龄放入B1、C1和D1单元格，然后将公式放入B2单元格，然后根据需要向下和向右拖动

=SUBSTITUTE(TRIM(MID(SUBSTITUTE($A2,CHAR(10),REPT(" ",100)),((COLUMN(A$2)-1)*100)+1,COLUMN($A$2)*100)),B1&": ","")

一种VBA阵列方法

除了上面的有效答案之外，这篇后期文章还演示了一种数组方法和双重拆分：

第[1]节通过等于Chr10的vbLf分隔符拆分为行， 第[2]节通过以下方式将拆分限制为两部分： 由于还不太清楚如何通过将输出限制为2个令牌（如第[2]节所示）来使用Split函数，请查看

语法

拆分表达式，[分隔符，[限制，[比较]]]

---

您有哪个版本的excel？在excel/Power Pivot/Power BI中还有其他方法吗？不幸的是，我没有访问0365版的权限。@WojciechUrjasz，当然。尽管我添加了一个非O365版本的FILTERXML路由，但值得一提的是，JvDV在上发布了FilterXMLXPath案例的优秀概述。FYI发布了另一种VBA方法@JvdVNice idea+可以拉伸原始字符串，并在之后使其恢复活力。然而，第2行和后面的行似乎包含前缀字符串Name:、Address:和Age:，而不是用-仅供参考，通过过滤添加了VBA阵列方法。

=SUBSTITUTE(TRIM(MID(SUBSTITUTE($A2,CHAR(10),REPT(" ",100)),((COLUMN(A$2)-1)*100)+1,COLUMN($A$2)*100)),B1&": ","")

Option Explicit

Sub SplitIntoTokens()
With Sheet1                                   ' << change to your project's sheet Code(Name)
    '[0] get string content
    Dim lastRow As Long
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim data As Variant
    data = .Range("A1:D" & lastRow).Value
    
    Dim i As Long
    For i = 2 To UBound(data)
        '[1] split into lines
        '    ~> Name: John|Address: USA, New York|Age: 66
        Dim lines: lines = Split(data(i, 1), vbLf)
        
        '[2] split into 2 parts only and take the 2nd one
        Dim ii As Long, tmp
        For ii = 0 To UBound(lines)
            lines(ii) = Split(lines(ii), ": ", 2)(1)    ' split via ": "-delimiter, 2nd part via index (1)
            data(i, ii + 2) = lines(ii)
        Next
        'Debug.Print Join(lines, "|") optional (display results in VB Editors Immediate Window
    Next
    
    '[3] write array results back to sheet
    .Range("A1").Resize(UBound(data), 4) = data             ' write data
    .Range("A1:D1") = Split("Data,Name,Address,Age", ",")   ' write header (if not existant)
End With
End Sub