ARTICLE · 1276283

Excel VBA编程-一键从文本里提取指定内容

发布时间：2026-10-30 10:30:29 最近访问：2026-10-30 10:30:33

Excel VBA编程-一键从文本里提取指定内容

上一讲我们用 VBA「一键把一列按分隔符拆分成多列」，把"HR-001-2026"这种一格挤三样的信息拆回了各列。但办公里还有另一类更常见的麻烦：一格长文本里只藏着你想要的那一小段——比如"浙江省杭州市西湖区"里其实只想要"杭州"、一张订单备注"NO20260828-000123"里只想截出中间的日期段、财务流水"付款方:ABC公司|收款方:XYZ集团|金额:5000"里只想要"XYZ集团"。手动去数第几个字、拿着鼠标一段段选，又慢又容易错。用 VBA 写一段，一键就把那一小截精准揪出来，才叫真正省事。

这一讲我们从网络上整理了一批 Excel VBA「从文本里提取指定内容」的实用技巧，核心就一句话：用 InStr 找到左右关键词的位置，再用 Mid 把中间那段截出来。这是 Exceldome、Statology、DevX 等站点公认最适合零基础的写法。CSDN 财务实战还补充了一个关键细节：提取"收款方:XYZ集团"这种带标签内容时，用 InStr + Len 跳过标签本身、再判断"结尾分隔符找不到"就截到末尾，避免报错——这正是我们今天"找不到就标未找到"思路的来源；StackOverflow 上从 Data_out(3,47,0,...) 括号文本里截取中间几位的写法，本质也是 InStr 定位、Mid 按位置取固定长度，和我们的案例三完全对应。

把这些揉到一起，这篇只讲一个核心套路：用 InStr 定位 → 用 Mid 截取 → 空值跳过 → 找不到就标出来 → 弹窗报告。下面用 3 个由浅入深的案例带你走一遍。

（小前提：下面所有代码都假设你当前打开的那张表就是你要处理的表。运行前先把表点成「当前表」。提取会把结果写到指定的空列里，动手前强烈建议先另存一份副本！）

案例一（简单）：一键提取「左词」和「右词」之间的内容

功能说明 这是最基础的「提取中间」。你只要把长文本放在 A 列（第一行是标题），把左右两个关键词写死在代码里（比如左词是"省"、右词是"市"），运行这一段，Excel 就会从 A 列第 2 行开始，把每个"省"和"市"之间的内容截出来写进 B 列——"浙江省杭州市西湖区"就变成"杭州"、"江苏省南京市玄武区"就变成"南京"，一直处理到数据最后一行。找不到关键词的行，B 列标"未找到"，不会报错。

代码

Sub 一键提取关键词之间()    ' 从 A 列每行文本里，提取「左词」和「右词」之间的内容，写进 B 列    ' 例：浙江省杭州市西湖区 → 杭州（左词「省」、右词「市」之间）    Dim 末行 As Long    Dim i As Long    Dim 文本 As String    Dim 左词 As String    Dim 右词 As String    Dim 起点 As Long    Dim 终点 As Long    左词 = "省"    右词 = "市"    末行 = Cells(Rows.Count, 1).End(xlUp).Row   ' 自动找 A 列最后一行    For i = 2 To 末行        文本 = Cells(i, 1).Value        If 文本 <> "" Then            起点 = InStr(文本, 左词) + Len(左词)   ' 跳过左词本身            终点 = InStr(文本, 右词)              ' 右词的位置            If 起点 > Len(左词) And 终点 > 起点 Then                Cells(i, 2).Value = Mid(文本, 起点, 终点 - 起点)            Else                Cells(i, 2).Value = "未找到"            End If        End If    Next i    MsgBox "提取完成！已把关键词之间的内容写到 B 列。", vbInformationEnd Sub

操作步骤

在 Excel 里准备好一张表：A 列放长文本（如"浙江省杭州市西湖区"、"江苏省南京市玄武区"…），第一行是标题（如"地址"），下面若干行数据，B 列留空，方便看提取效果。
按 Alt + F11 打开 VBA 编辑器，点菜单「插入」→「模块」，把上面的代码整段粘进去。
回到 Excel，点一下你的数据表让它成为「当前表」，按 Alt + F 8，选中「一键提取关键词之间」，点「运行」。
程序会从第 2 行扫到最后一行，把每行"省"和"市"之间的内容写进 B 列，最后弹窗提示完成。
想换别的关键词（比如从"付款方:张三|收款方:李四"里取"收款方:李四"中间的人名）？把代码里 左词 = "省"、右词 = "市" 改成你要的左右词再运行即可。

小提示：InStr(文本, 左词) 返回"左词"第一次出现的位置（找不到返回 0），Len(左词) 是左词长度。起点 = InStr + Len(左词) 意思是"从左边这个词后面开始取"，这样"省"字本身不会算进去。终点 是右词位置，Mid(文本, 起点, 终点 - 起点) 就是中间那段。循环里 For i = 2 To 末行 的 2 是专门让开第 1 行标题。

案例二（中等）：运行时自己选【源列】【目标列】【左右关键词】

功能说明 案例一的左词、右词、列都写死在代码里。这个案例改成：运行后弹框让你输入「要提取的源列字母」「结果放到的目标列字母」「左边的关键词」「右边的关键词」。程序会自动找到那一列的末行，把每行左右词之间的内容截出来，写进目标列——不管你表有多少行、提哪一列、左右词是什么，都不用手改代码。任一框留空，程序会提示并自动停下。

代码

Sub 一键提取指定列关键词之间()    ' 运行时输入：源列、目标列、左关键词、右关键词    ' 把源列每行左右词之间的内容，截出来写到目标列    Dim 源列 As String    Dim 目标列 As String    Dim 左词 As String    Dim 右词 As String    Dim 源号 As Long    Dim 目标号 As Long    Dim 末行 As Long    Dim i As Long    Dim 文本 As String    Dim 起点 As Long    Dim 终点 As Long    源列 = InputBox("要提取的源列字母，例如 A：", "源列")    目标列 = InputBox("提取结果放到的列字母，例如 B：", "目标列")    左词 = InputBox("左边的关键词，例如 省：", "左关键词")    右词 = InputBox("右边的关键词，例如 市：", "右关键词")    If 源列 = "" Or 目标列 = "" Or 左词 = "" Or 右词 = "" Then        MsgBox "已取消，四项都要填写。", vbExclamation        Exit Sub    End If    源号 = Range(源列 & "1").Column      ' 把列字母转成列号    目标号 = Range(目标列 & "1").Column    末行 = Cells(Rows.Count, 源号).End(xlUp).Row    For i = 2 To 末行        文本 = Cells(i, 源号).Value        If 文本 <> "" Then            起点 = InStr(文本, 左词) + Len(左词)            终点 = InStr(文本, 右词)            If 起点 > Len(左词) And 终点 > 起点 Then                Cells(i, 目标号).Value = Mid(文本, 起点, 终点 - 起点)            Else                Cells(i, 目标号).Value = "未找到"            End If        End If    Next i    MsgBox "提取完成！结果已写到 " & 目标列 & " 列。", vbInformationEnd Sub

操作步骤

把代码粘进同一个模块（和案例一放一起也行）。表里准备一张要提取的数据做测试（如 A 列是"付款方:ABC|收款方:XYZ|金额:5000"这类带标签的文本）。
回到 Excel，点一下数据表让它成为「当前表」，按 Alt + F 8 运行「一键提取指定列关键词之间」。
依次在弹框里输入源列字母（如 A）、目标列字母（如 B）、左关键词（如 收款方:）、右关键词（如 |），点「确定」。
程序自动找到该列末行，把每行左右词之间的内容截出来写进目标列，弹窗提示完成。
任意一步留空，程序会提示并自动停下，不会乱改你的数据。

关键点：用 Range(源列 & "1").Column 把列字母（如 "A"）转成真正的列号（1、2、3…），后面 Cells(i, 源号) 才能定位。判断里 起点 > Len(左词) 是兜"左词没找到"的——InStr 返回 0 时 起点 正好等于 Len(左词)，条件不成立就走"未找到"，绝不会乱截。全程只用学过的 Cells、End、InputBox、For…Next、InStr、Mid、Len。

案例三（实用小案例）：一键截取「固定位置、固定长度」的一段并统计报告

功能说明 前面两个案例都是"找关键词再取中间"。但还有一类情况：文本格式特别规整，想要的那段永远在固定的第几个字、固定几个字长——比如一串长编号"XM20260828123XYZ"里，第 3 个字符起连续 8 个字符恰好是日期"20260828"；又或者 18 位身份证里第 7 位起 8 位是出生日期。这个案例运行后会：让你输入「源列」「目标列」「从第几位开始取」「一共取几个字」，把每行那段截出来；同时统计"成功提取多少行、因长度不够跳过多少行"，最后弹窗报告，方便你一眼看出哪些行数据太短、截不出来。

代码

Sub 一键提取固定长度一段()    ' 从源列每行文本里，从「第几位」开始，取「几个字」，写到目标列    ' 例：从第3个字符起取8个字符（可用于从长编号里截出日期段）    Dim 源列 As String    Dim 目标列 As String    Dim 起始 As Long    Dim 长度 As Long    Dim 源号 As Long    Dim 目标号 As Long    Dim 末行 As Long    Dim i As Long    Dim 文本 As String    Dim 成功数 As Long    Dim 太短数 As Long    源列 = InputBox("要提取的源列字母，例如 A：", "源列")    目标列 = InputBox("结果放到的列字母，例如 B：", "目标列")    起始 = Val(InputBox("从第几个字符开始取（1 表示第1个）：", "起始位置"))    长度 = Val(InputBox("一共取几个字符：", "取的长度"))    If 源列 = "" Or 目标列 = "" Or 起始 < 1 Or 长度 < 1 Then        MsgBox "已取消，参数要填对（起始和长度都要是正整数）。", vbExclamation        Exit Sub    End If    源号 = Range(源列 & "1").Column    目标号 = Range(目标列 & "1").Column    末行 = Cells(Rows.Count, 源号).End(xlUp).Row    成功数 = 0    太短数 = 0    For i = 2 To 末行        文本 = Cells(i, 源号).Value        If 文本 <> "" Then            If Len(文本) >= 起始 + 长度 - 1 Then                Cells(i, 目标号).Value = Mid(文本, 起始, 长度)                成功数 = 成功数 + 1            Else                Cells(i, 目标号).Value = "长度不够"                太短数 = 太短数 + 1            End If        End If    Next i    MsgBox "提取完成！" & vbCrLf & "成功提取：" & 成功数 & " 行" & vbCrLf & "长度不够跳过：" & 太短数 & " 行", vbInformationEnd Sub

操作步骤

把代码粘进模块（和前两个可以放在同一个模块里）。准备一张 A 列是长编号的表（如"XM20260828123XYZ"、"XM20260901555ABC"…），B 列留空。
点一下数据表让它成为「当前表」，按 Alt + F 8 运行「一键提取固定长度一段」。
依次输入源列（如 A）、目标列（如 B）、起始位置（如 3）、取的长度（如 8），点「确定」。
程序把每行第 3 个字符起的 8 个字截出来写进 B 列（得到"20260828"这类日期段）；长度不够的行标"长度不够"，最后弹窗报告成功几行、跳过几行。
拿到"长度不够"的行号对应的数据，回去补全，再跑一次即可。

关键经验（来自网络实战总结）：

固定位置用 Mid(文本, 起始, 长度)：第 3 个起取 8 个就是 Mid(文本, 3, 8)，比 InStr 找词更适合"格式死板"的编号、身份证、流水号。
长度够不够要先判断：If Len(文本) >= 起始 + 长度 - 1 决定这行截不截得出来，不够就标"长度不够"，绝不会截出乱码或半截。
统计靠两个计数器：成功数 和 太短数 在循环里各自加 1，最后一次性报告，数据质量一眼可见。
末行用 End(xlUp) 动态找，表加行减行都不用改代码；保存工作簿一定要存成 .xlsm 格式，否则宏会丢失。

知识点小结

用 VBA 从文本里提取指定内容，本质上就是把"手动去数第几个字、拿鼠标一段段选"这件事，翻译成一段固定动作：用 InStr 定位 → 用 Mid 截取 → 空值用 If 跳过 → 找不到就标出来 → 弹窗报告。三句话记牢就够用：

定位靠 InStr → InStr(文本, 关键词) 返回关键词第一次出现的位置，找不到就是 0；起点 = InStr + Len(关键词) 表示"从关键词后面开始取"，关键词本身不算进去；
截取靠 Mid → Mid(文本, 起点, 长度) 从起点取指定长度的字符；要取"左右词之间"，长度就写 终点 - 起点（终点也是用 InStr 找的右词位置）；
不乱靠 If → If 文本 <> "" 跳过空行、If 起点 > Len(左词) And 终点 > 起点 兜住"关键词找不到"的情况，截出来的内容永远准确。

它和前面学的「拆分列」「加前后缀」「合并多列」「查找替换」是一套组合拳：拆分管"把挤在一格里的几样东西归回各列"、提取管"从长文本里精准揪出想要的那一截"、前后缀管"给现成内容统一穿马甲"、合并管"把分散的几列拼成完整一列"、替换管"把写错/不统一的词扶正"——从收数、清数、拼装到精准提取，全程不用手动点一下。

【SVG 示意图】

下一篇预告：把"藏在长文本里的信息"精准揪出来之后，日常还常遇到"文本前后多了空格、大小写乱七八糟"——比如从网页复制来的名字前后带空格、英文产品名大小写不统一，导致 VLOOKUP 对不上、统计出错。下一篇我们继续从网络上抓取新的 VBA 实用技巧，带你解锁「一键清理文本（清除首尾空格、统一大小写，用 Trim、UCase、LCase）」——不靠手改，也能把乱糟糟的文本一键收拾干净。