vba将excel按照某一列拆分成多个文件（Vba将excel 数据写入xml 文件）真没想到

? Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
? c=Application.InputBox(“请输入拆分列号”, , 4, , , , , 1)
? If c=0 Then Exit Sub
? Application.ScreenUpdating=False
? Application.DisplayAlerts=False
? arr=[a1].CurrentRegion
? lc=UBound(arr, 2)
? Set rng=[a1].Resize(, lc)
? Set d=CreateObject(“scripting.dictionary”)
? For i=2 To UBound(arr)
? If Not d.Exists(arr(i, c)) Then
? Set d(arr(i, c))=Cells(i, 1).Resize(1, lc)
? Else
? Set d(arr(i, c))=Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
? End If
? Next
? k=d.Keys
? t=d.Items
? For i=0 To d.Count – 1
? With Workbooks.Add(xlWBATWorksheet)
? rng.Copy .Sheets(1).[a1]
? t(i).Copy .Sheets(1).[a2]
? .SaveAs Filename:=ThisWorkbook.Path & “” & k(i) & “.xls”
? .Close
? End With
? Next
? Application.DisplayAlerts=True
? Application.ScreenUpdating=True
? MsgBox “完毕”
End Sub