【Excel宏自动化】按列拆分导出CSV,这个一键宏帮你省下80%的时间!-夜雨聆风

【Excel宏自动化】按列拆分导出CSV,这个一键宏帮你省下80%的时间!

大家好，我是你们的老朋友Menphis。

上周市场部的小王找我哭诉：手里有一份全公司5000多人的客户数据，需要按“负责销售”这一列拆分成几十个CSV文件，分别发给对应的销售。手动筛选、复制、新建文件、粘贴、保存……重复几十次，一上午就没了，还差点把某个销售的数据漏掉。

我听完笑了：“这活我两年前就自动化了。”然后甩给他这个一键宏，1分钟搞定。今天就把这个按列拆分导出CSV的利器分享给你，从此告别机械重复的筛选保存。

按下面几个步骤，两分钟就能搞定～

📌 如何操作excel实现

创建宏
复制粘贴魔法代码
执行宏
打开文件夹查看导出文件

1. 创建宏

2. 复制粘贴魔法代码，并保存

Sub 按列拆分导出CSV()    Application.ScreenUpdating = False    Dim ws As Worksheet, dict As Object    Dim lastRow As Long, i As Long, savePath As String    Dim key As Variant, cellValue As String    Set ws = ActiveSheet    Set dict = CreateObject("Scripting.Dictionary") ' 用于存储唯一分类值    savePath = ThisWorkbook.Path & "\" ' CSV保存路径（同Excel文件目录）    ' 获取需要拆分的列（此处为B列，可修改为其他列，如"C"）    Const splitColumn As String = "B"    lastRow = ws.Cells(ws.Rows.Count, splitColumn).End(xlUp).Row    ' 收集所有唯一分类值（假设第一行是表头，从第2行开始）    For i = 2 To lastRow        cellValue = Trim(ws.Cells(i, splitColumn).Value)        If cellValue <> "" Then            dict(cellValue) = "" ' 存入字典去重        End If    Next i    ' 按每个分类值导出CSV    For Each key In dict.Keys        ' 筛选当前分类的数据        ws.Range("A1:" & ws.Cells(lastRow, ws.Columns.Count).End(xlToLeft).Address).AutoFilter Field:=ws.Columns(splitColumn).Column, Criteria1:=key        ' 复制筛选后的数据（包括标题）        ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy        ' 创建新工作簿并粘贴数据        With Workbooks.Add            .Sheets(1).Range("A1").PasteSpecial xlPasteValues ' 仅粘贴值，避免格式问题            ' 保存为CSV文件            .SaveAs Filename:=savePath & key & ".csv", FileFormat:=xlCSV, Local:=True            .Close SaveChanges:=False ' 关闭新工作簿        End With    Next key    ' 取消筛选    ws.AutoFilterMode = False    MsgBox "✅ 导出完成！共生成 " & dict.Count & " 个CSV文件，保存路径：" & savePath, vbInformation, "提示"    Application.ScreenUpdating = TrueEnd Sub