DeepSeek自动拆分Excel表格，太强了吧！

都知道DeepSeek写代码牛，没想到这么牛的。昨晚在几千名同学见证下，DeepSeek展示了它强大的写代码能力。

事情是这样的，在昨晚直播中，兰色要演示一下兰色工具栏中，那个神秘的表格拆分功能是如何做成的。

先看拆分效果

这么高级的功能，估计很多同学以为只有高高手才能做到，其实借助Deepseek所有人都可以完成。想学就跟兰色一起做吧。

1、让 DeepSeek帮我们写代码

帮我用VBA编写一段表格拆分代码，执行弹出一个提示窗口，点退出退出拆分，点确定对所选列按项目进行拆分成单独的工作表

很快代码编写完成。

Sub SplitDataByProject() Dim selectedRange As Range Dim splitColumn As Long Dim dict As Object Dim cell As Range Dim key As Variant Dim newSheet As Worksheet Dim originalSheet As Worksheet Dim response As VbMsgBoxResult ' 显示确认对话框 response = MsgBox("是否按所选列拆分数据？" & vbCrLf & _ "点击确定开始拆分，点击取消退出", _ vbOKCancel + vbQuestion, "表格拆分") If response = vbCancel Then Exit Sub ' 获取当前选择范围 On Error Resume Next Set selectedRange = Selection On Error GoTo 0 If selectedRange Is Nothing Then MsgBox "请先选择要拆分的列！", vbExclamation Exit Sub End If ' 获取拆分列号 splitColumn = selectedRange.Column ' 创建字典存储唯一值 Set dict = CreateObject("Scripting.Dictionary") Set originalSheet = ActiveSheet ' 收集唯一值（跳过空值和标题行） For Each cell In originalSheet.UsedRange.Columns(splitColumn).Cells If cell.Row > 1 And Not IsEmpty(cell) Then dict(cell.Value) = 1 End If Next cell If dict.Count = 0 Then MsgBox "所选列没有可拆分的数据！", vbExclamation Exit Sub End If ' 优化性能设置 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False ' 遍历字典键值 For Each key In dict.Keys ' 清理工作表名称 Dim sheetName As String sheetName = CleanSheetName(CStr(key)) ' 删除已存在的工作表 If SheetExists(sheetName) Then Worksheets(sheetName).Delete End If ' 创建新工作表 Set newSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) newSheet.Name = sheetName ' 复制标题行 originalSheet.Rows(1).Copy newSheet.Rows(1) ' 筛选并复制数据 originalSheet.UsedRange.AutoFilter Field:=splitColumn, Criteria1:=key originalSheet.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy _ newSheet.Range("A2") ' 调整列宽 newSheet.Cells.EntireColumn.AutoFit Next key ' 恢复原始设置 originalSheet.AutoFilterMode = False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True MsgBox "成功拆分出 " & dict.Count & " 个工作表！", vbInformationEnd Sub

' 工作表名称清理函数Function CleanSheetName(str As String) As String Dim invalidChars As String invalidChars = "!@#$%^&*()+-=[]{};':"",./<>?\|`~" Dim i As Integer ' 替换特殊字符 For i = 1 To Len(invalidChars) str = Replace(str, Mid(invalidChars, i, 1), "_") Next i ' 处理开头为单引号的情况 If Left(str, 1) = "'" Then str = "_" & Right(str, Len(str) - 1) ' 截断超过31字符的名称 If Len(str) > 31 Then str = Left(str, 31) End If CleanSheetName = strEnd Function

' 检查工作表是否存在Function SheetExists(sheetName As String) As Boolean On Error Resume Next SheetExists = Not Worksheets(sheetName) Is Nothing On Error GoTo 0End Function

2、试运行

新建一个空白的Excel工作簿，准备一些测试数据，把代码粘到VBE编辑器的一个新模块内。

把光标放在主程序中（Sub开头的代码)，然后同时选取表格某一列测试的表格式，点击VBE编辑器中的运行命令。真的没想到，一次就成功！Deepseek写代码能力真的太强了！

3、加载代码

把文件另存为Excel加载宏格式，在加载项窗口画勾启用。

4、添加命令

在工具栏上右键自定义功能区 - 宏，把宏名称添加到右侧的工具栏中。

搞定！

兰色说：其实现场的演示，兰色还是有点担心Deepseek会翻车，做好了如果不行下一步该怎么处理的预案。但结果一次成功，不得不说Deepseek太强了。