...命令将一个EXCEL文件(文件里有1万多行数据)每500行数据,分成一个EX...

发布网友发布时间：2024-03-06 21:15

共1个回答

热心网友时间：2024-03-08 12:21

Sub 拆分表()
Application.ScreenUpdating = False
Dim clm_d, hh As Integer
Dim mycell As Range
Dim nodupes As New Collection
Dim rngop As Range
Set shtop = ActiveSheet
hh = Application.CountA(Range("1:110"))
clm_d = Application.InputBox(prompt:="请选择作为拆分的列" & Chr(13) _
& "注意:" & Chr(13) & "1、拆分要第一行为标题行" & Chr(13) & "2、输处列号(如1,2),用键盘输入", Type:=1)
If clm_d = False Or clm_d > hh Then Exit Sub
On Error Resume Next
For Each mycell In shtop.Range(Cells(4, clm_d), (shtop.Cells(4, clm_d).End(xlDown)))
nodupes.Add mycell.Value, CStr(mycell.Value)
Next mycell
On Error GoTo 0
Set rngop = Cells.CurrentRegion
For Each Item In nodupes
rngop.AutoFilter Field:=clm_d, Criteria1:=Item
rngop.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = Item
ActiveSheet.Paste
Next Item
rngop.AutoFilter
shtop.Activate
Application.ScreenUpdating = True
End Sub