如何用VBA从Excel单元格字符串提取指定数据并整理成表格？

一、核心VBA提取函数及实操示例 #

针对单元格内的键值对（如Btc: 100, Qua: 200），可以用以下VBA函数组合实现提取：

1. InStr + Mid 精准截取 #

适合格式固定的键值对，直接定位关键字位置后截取内容：

Sub ExtractKVWithMid()
    Dim sourceRng As Range, cell As Range
    Dim rowNum As Integer
    Dim cellText As String, btcStart As Integer, btcEnd As Integer, quaStart As Integer, quaEnd As Integer
    
    ' 选中数据区域
    Set sourceRng = Selection
    rowNum = 2 ' 目标表格起始行（假设第一行是表头）
    
    For Each cell In sourceRng
        cellText = cell.Value
        ' 提取Btc值
        btcStart = InStr(cellText, "Btc:") + Len("Btc:")
        btcEnd = InStr(btcStart, cellText, ",")
        If btcEnd = 0 Then btcEnd = Len(cellText)
        Range("B" & rowNum).Value = Trim(Mid(cellText, btcStart, btcEnd - btcStart))
        
        ' 提取Qua值
        quaStart = InStr(cellText, "Qua:") + Len("Qua:")
        quaEnd = InStr(quaStart, cellText, ",")
        If quaEnd = 0 Then quaEnd = Len(cellText)
        Range("C" & rowNum).Value = Trim(Mid(cellText, quaStart, quaEnd - quaStart))
        
        rowNum = rowNum + 1
    Next cell
End Sub

2. Split 批量拆分键值对 #

适合键值对数量较多的场景，先按分隔符拆分出单个键值，再拆分键和值：

Sub ExtractKVWithSplit()
    Dim sourceRng As Range, cell As Range
    Dim rowNum As Integer
    Dim kvPairs As Variant, kv As Variant
    Dim key As String, value As String
    
    Set sourceRng = Selection
    rowNum = 2
    
    For Each cell In sourceRng
        ' 按逗号拆分所有键值对
        kvPairs = Split(cell.Value, ",")
        For Each kv In kvPairs
            kv = Trim(kv)
            ' 按冒号拆分键和值
            key = Trim(Split(kv, ":")(0))
            value = Trim(Split(kv, ":")(1))
            
            ' 根据键写入对应列
            Select Case key
                Case "Btc": Range("B" & rowNum).Value = value
                Case "Qua": Range("C" & rowNum).Value = value
                ' 可添加其他键的处理逻辑
            End Select
        Next kv
        rowNum = rowNum + 1
    Next cell
End Sub

3. 正则表达式处理复杂格式 #

如果键值对格式不固定（比如有多余空格、特殊符号），用正则表达式更灵活：

注意：先打开VBA编辑器，点击工具-引用，勾选Microsoft VBScript Regular Expressions 5.5

Sub ExtractKVWithRegEx()
    Dim sourceRng As Range, cell As Range
    Dim rowNum As Integer
    Dim regEx As New RegExp
    Dim matches As MatchCollection, match As Match
    
    regEx.Pattern = "(\w+):\s*([\d\.]+)" ' 匹配"键: 值"格式，支持数字和小数
    regEx.Global = True ' 全局匹配所有键值对
    
    Set sourceRng = Selection
    rowNum = 2
    
    For Each cell In sourceRng
        Set matches = regEx.Execute(cell.Value)
        For Each match In matches
            key = match.SubMatches(0)
            value = match.SubMatches(1)
            
            Select Case key
                Case "Btc": Range("B" & rowNum).Value = value
                Case "Qua": Range("C" & rowNum).Value = value
            End Select
        Next match
        rowNum = rowNum + 1
    Next cell
End Sub

二、无需VBA的更简便方案：Power Query #

如果不想写代码，用Excel自带的Power Query可以快速完成：

1. 选中包含键值对的数据列，点击数据选项卡 → 从表格/区域（Excel 2016及以上版本）
2. 在Power Query编辑器中，选中目标列，点击拆分列 → 按分隔符，选择逗号，设置拆分到行
3. 再次选中拆分后的列，点击拆分列 → 按分隔符，选择冒号，设置拆分到列
4. 选中拆分后的"键"列，点击转换 → 透视列，值列选择拆分后的"值"列，高级选项选择不要聚合
5. 点击关闭并上载，即可得到结构清晰的标准化表格

内容的提问来源于stack exchange，提问作者Lukas Nickus