|
|
楼主 |
发表于 2023-4-8 13:08
|
显示全部楼层
以前坛子里有大神帮助过一次，但是针对现在这个需求，语句需要改动，但是我改动了N次，得不到我想要的，我太菜了
Sub 一() '按指定列分组拆分数据
Sheets(1).Select
Ro = [A1048576].End(3).Row '根据第A列提取最大行数
Co = [XFD1].End(1).Column '根据第1行提取最大列数
Dim i As Long, sht As Worksheet
'm = InputBox("按第几列拆分？" & Chr(10) & Chr(10) & "列序数范围：1 至 " & Co & "")
'获取拆分列的信息,只需要列号
Dim lie As Range
Set lie = Application.InputBox(prompt:="请选择拆分的列：选择拆分列内任意单元格即可", Type:=8)
Dim liemin As Long
liemin = lie.Column
' '退出机制
' If Not IsNumeric(m) Then
' MsgBox "你输入的不是数字！"
' Exit Sub
' ElseIf m * 1 > Co Then
' MsgBox "超出了数据的列数！"
' Exit Sub
' End If
'删除分表
'Call 删除分表
'创建新表
tm = Now()
For i = 2 To Ro
k = 0
For Each sht In Sheets
If sht.Name = Sheets(1).Cells(i, liemin * 1) Then
k = 1
Exit For
End If
Next
If k = 0 Then
Sheets.Add(after:=Sheets(Sheets.Count)).Name = Sheets(1).Cells(i, liemin * 1)
End If
Next
'拷贝数据
For i = 2 To Sheets.Count
Sheets(1).[A1].Resize(Ro, Co).AutoFilter Field:=liemin, Criteria1:=Sheets(i).Name
Sheets(1).[A1].Resize(Ro, Co).Copy Sheets(i).[A1]
Next
Sheets(1).[A1].Resize(Ro, Co).AutoFilter
Sheets(1).Select
MsgBox "操作完毕！耗时:" & Format(Now() - tm, "hh:mm:ss") |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-8 13:04
