昨天兰色分享了让Deepseek设置公式的方法,顺利完成了要求。今天再试一个更难的表格处理。
如下图表中,要求按A列项目内容拆分成多个表格并另存为单独的excel文件,文件名为A列的值。
要求拆分后果:
具体操作步骤:
1、让DeepSeek生成代码
打开https://www.deepseek.com/,点别针先把表格文件上传(上传表格截图也可以)
把问题提交给deepSeek(一定要描述清楚)
很快思路和VBA代码就生成了,而且提供了代码的详细使用说明
Sub SplitDataByProject() Dim dict As Object Dim wsSource As Worksheet Dim lastRow As Long, i As Long Dim key As Variant Dim newWb As Workbook Dim newWs As Worksheet Dim savePath As String
'设置字典用于存储唯一项目值 Set dict = CreateObject("Scripting.Dictionary") Set wsSource = ThisWorkbook.Sheets("A表") '根据实际表名修改
'获取数据最后一行 lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
'收集唯一项目值(排除标题行) For i = 2 To lastRow If Not dict.exists(wsSource.Cells(i, 1).Value) Then dict.Add wsSource.Cells(i, 1).Value, Nothing End If Next i
'设置保存路径(默认为当前工作簿路径) savePath = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False Application.DisplayAlerts = False
'循环处理每个项目 For Each key In dict.keys '创建新工作簿 Set newWb = Workbooks.Add Set newWs = newWb.Sheets(1)
'复制标题行 wsSource.Rows(1).Copy newWs.Rows(1)
'筛选并复制数据 wsSource.Range("A1:F" & lastRow).AutoFilter Field:=1, Criteria1:=key wsSource.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy newWs.Range("A2")
'清除筛选 wsSource.AutoFilterMode = False
'保存文件 newWb.SaveAs savePath & key & ".xlsx" newWb.Close Next key
'恢复设置 Application.ScreenUpdating = True Application.DisplayAlerts = True
MsgBox "已拆分生成 " & dict.Count & " 个文件!"End Sub
2、按上面说明执行代码
按Alt+f11打开VBE编程器(WPS需要安装WPS VBA插件)
插入菜单-添加模块后,把代码粘贴的右侧空白处中,点三角运行
只需1秒,在当前文件夹下就生成4个新文件
打开后正是拆分后的表格,DeepSeek任务顺利完成。
如果代码需要保存在excel工作簿内,文件需要另存为启用宏的工作簿
兰色说:有了VBA加持,DeepSeep可以帮我们完成很多复杂工作,除了本文的拆分,合并多个excel文件等操作也可以搞定。
领取专属 10元无门槛券
私享最新 技术干货