具：DEEPSEEK、或者百度DEEPSEEK满血版、腾讯元宝

提示词：将EXCEL工作表的数据进行拆分成多个文件并重新命名，按照第4列进行拆分,写出VBA代码，考虑兼容WPS

需要处理的表格如下图所示：

VBA代码：

Sub SplitByColumnD()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Dim ws As Worksheet

Dim dict As Object

Dim LastRow As Long, i As Long

Dim Key As Variant

Dim SavePath As String

Dim NewWB As Workbook

Dim FileDialog As FileDialog

Set ws = ActiveSheet

Set dict = CreateObject("Scripting.Dictionary")

' 获取保存路径

Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)

FileDialog.Title = "选择保存位置"

If FileDialog.Show <> -1 Then Exit Sub

SavePath = FileDialog.SelectedItems(1) & "\"

' 获取唯一键值(第4列)

LastRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row

For i = 2 To LastRow

If Not IsEmpty(ws.Cells(i, 4)) Then

dict(ws.Cells(i, 4).Value) = 1

End If

Next i

' 遍历每个键值拆分数据

For Each Key In dict.Keys

' 应用筛选

ws.UsedRange.AutoFilter Field:=4, Criteria1:=Key

' 创建新工作簿

Set NewWB = Workbooks.Add

ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy NewWB.Sheets(1).Range("A1")

' 清理格式

With NewWB.Sheets(1)

.Cells.Copy

.Cells.PasteSpecial xlPasteValues

.Cells.PasteSpecial xlPasteFormats

.Cells(1, 1).Select

End With

Application.CutCopyMode = False

' 保存文件

Dim SafeName As String

SafeName = Replace(Key, "/", "-") ' 处理非法字符

SafeName = Replace(SafeName, "\", "-")

NewWB.SaveAs SavePath & SafeName & ".xlsx"

NewWB.Close False

Next Key

' 恢复设置

ws.AutoFilterMode = False

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

MsgBox "拆分完成！共生成 " & dict.Count & " 个文件", vbInformation

End Sub

操作步骤：鼠标依次单击“开发工具”——“Visual Basic”，然后会打开VB的编辑环境，鼠标再依次单击“插入”——“模块”，然后粘贴上方代码，并关闭VB编辑环境，最后，再单击“开发工具”——“宏”，在弹出的对话框，单击执行按钮。完成后的效果如下图所示。