如何使用VBA提取Excel列中特定数据并解析写入另一列

• 代码支持自定义提取规则，可根据你的实际解析需求修改匹配逻辑
• 运行前可自行指定工作表、数据起始行等参数
• 处理完成后会自动弹窗提示处理条数

使用步骤 #

1. 打开目标Excel文件，按Alt + F11唤出VBA编辑器
2. 右键点击左侧工程资源管理器中的当前工作簿，选择「插入」-「模块」
3. 将下方代码粘贴到模块编辑窗口
4. 按F5运行ParseBColumnToD过程即可完成处理

Sub ParseBColumnToD()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sourceStr As String
    Dim resultStr As String
    
    ' 绑定工作表，如需固定工作表可替换为 Set ws = Sheets("你的工作表名称")
    Set ws = ActiveSheet
    ' 获取B列最后一个非空行的行号
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历数据行，默认第1行为表头，从第2行开始处理，可自行修改i的初始值
    For i = 2 To lastRow
        sourceStr = Trim(ws.Cells(i, "B").Value)
        If sourceStr <> "" Then
            resultStr = ExtractTargetInfo(sourceStr)
            ws.Cells(i, "D").Value = resultStr
        End If
    Next i
    
    ' 自动调整D列列宽，不需要可删除
    ws.Columns("D").AutoFit
    MsgBox "处理完成，共处理" & lastRow - 1 & "条数据", vbInformation
End Sub

' 自定义提取规则函数，根据实际需求修改内部逻辑即可
Function ExtractTargetInfo(sourceStr As String) As String
    ' === 以下为示例规则，可按需修改或替换 ===
    ' 示例：提取字符串中"订单号:"后的连续字符（以空格为结束标识）
    Dim startFlag As String, endFlag As String
    startFlag = "订单号:"
    endFlag = " "
    
    Dim startPos As Long, endPos As Long
    startPos = InStr(1, sourceStr, startFlag, vbTextCompare)
    If startPos > 0 Then
        startPos = startPos + Len(startFlag)
        endPos = InStr(startPos, sourceStr, endFlag)
        If endPos = 0 Then endPos = Len(sourceStr) + 1
        ExtractTargetInfo = Trim(Mid(sourceStr, startPos, endPos - startPos))
        Exit Function
    End If
    
    ' 如需使用正则匹配可取消下方注释，修改Pattern为你需要的正则表达式即可
    ' Dim regEx As Object
    ' Set regEx = CreateObject("VBScript.RegExp")
    ' regEx.Global = True
    ' regEx.Pattern = "\d+" ' 匹配连续数字的正则，可按需修改
    ' If regEx.Test(sourceStr) Then
    '     ExtractTargetInfo = regEx.Execute(sourceStr)(0)
    '     Exit Function
    ' End If
    
    ' 无匹配内容时返回空值
    ExtractTargetInfo = ""
End Function

如需要调整提取规则，仅需修改ExtractTargetInfo函数内的匹配逻辑即可，支持字符串截取、正则匹配等所有VBA支持的文本处理方式。

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