具：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編輯環境，最后，再單擊“開發工具”——“宏”，在彈出的對話框，單擊執行按鈕。完成后的效果如下圖所示。