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