嘿，三年没碰VBA确实容易手生，别担心，我帮你把这个提取逻辑理清楚，直接上能用的代码！

先明确你的核心需求：

• 部门名称：固定在**冒号(:)和连字符(-)**之间，用正则非贪婪匹配就能精准抓取
• 日期：从源字符串里提取，我先按常见的YYYY-MM-DD格式写规则，后面会告诉你怎么适配你的实际日期格式

完整VBA代码 #

Sub ExtractDeptAndDate()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim regExDept As Object, regExDate As Object
    Dim deptMatch As Object, dateMatch As Object
    
    ' 绑定要操作的工作表（默认当前激活表，可改成具体表名比如Sheet1）
    Set ws = ActiveSheet
    ' 获取C列最后一行的行号，避免空循环
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' 后期绑定正则对象，不用手动引用库，方便直接用
    Set regExDept = CreateObject("VBScript.RegExp")
    Set regExDate = CreateObject("VBScript.RegExp")
    
    ' 配置部门正则规则：匹配冒号到连字符之间的内容（非贪婪模式防止多取）
    With regExDept
        .Pattern = ":(.*?)-"
        .Global = False ' 只取第一个符合的部门
        .IgnoreCase = True ' 忽略大小写，不需要可改成False
    End With
    
    ' 配置日期正则规则，这里以YYYY-MM-DD为例，按需修改
    ' 比如MM/DD/YYYY格式就改成 "\d{2}/\d{2}/\d{4}"
    With regExDate
        .Pattern = "\d{4}-\d{2}-\d{2}"
        .Global = False ' 只取第一个符合的日期
        .IgnoreCase = True
    End With
    
    ' 遍历C列源数据（从第2行开始，假设第1行是表头）
    For Each cell In ws.Range("C2:C" & lastRow)
        If cell.Value <> "" Then
            ' 提取部门
            Set deptMatch = regExDept.Execute(cell.Value)
            If deptMatch.Count > 0 Then
                ' 取括号里的分组内容，Trim去掉前后可能的空格
                ws.Cells(cell.Row, "B").Value = Trim(deptMatch(0).SubMatches(0))
            Else
                ws.Cells(cell.Row, "B").Value = "" ' 匹配不到时留空，也可改成"未找到部门"
            End If
            
            ' 提取日期
            Set dateMatch = regExDate.Execute(cell.Value)
            If dateMatch.Count > 0 Then
                ws.Cells(cell.Row, "A").Value = dateMatch(0).Value
                ' 可选：把A列设置为标准日期格式
                ws.Cells(cell.Row, "A").NumberFormat = "yyyy-mm-dd"
            Else
                ws.Cells(cell.Row, "A").Value = "" ' 匹配不到时留空
            End If
        End If
    Next cell
    
    ' 释放对象，避免内存占用
    Set regExDept = Nothing
    Set regExDate = Nothing
    Set ws = Nothing
    
    MsgBox "提取完成！"
End Sub

关键调整说明 #

1. 日期格式适配：如果你的日期不是YYYY-MM-DD，直接修改regExDate.Pattern即可：
   • 中文日期YYYY年MM月DD日："\d{4}年\d{2}月\d{2}日"
   • 短日期MM/DD/YY："\d{2}/\d{2}/\d{2}"
2. 部门分隔符带空格：如果源字符串是: 财务部 -这种格式，把部门正则改成:\s*(.*?)\s*-，用\s*匹配任意空格
3. 工作表切换：如果数据不在当前激活表，把Set ws = ActiveSheet改成Set ws = ThisWorkbook.Sheets("你的工作表名")

运行前记得保存工作簿，按Alt+F11打开VBA编辑器，把代码粘贴到模块里，回到Excel执行宏就搞定啦！

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