根据编号列数字重新分班

xaohaz · 发表于 2019-8-22 22:47

请老师们帮忙修改代码：

根据编号列数字重新分班，编号“1”生成新工作表“1”，把sheet1 B：H列内容汇总填到新工作表“1”，并按B列排序；编号“2”生成新工作表“2”…… 以此类推

详细内容见附件，谢谢。

lsc900707 · 发表于 2019-8-23 06:38

论坛里搜索学习一下“按列拆分工作表”！

朱荣兴 · 发表于 2019-8-23 07:37

提示: 作者被禁止或删除内容自动屏蔽

liulang0808 · 发表于 2019-8-23 08:07

Sub test()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
arr = ActiveSheet.UsedRange
For j = 2 To UBound(arr)
If d.exists(arr(j, 1)) Then
Set d(arr(j, 1)) = Union(d(arr(j, 1)), Cells(j, 1))
Else
Set d(arr(j, 1)) = Union(Cells(1, 1), Cells(j, 1))
End If
Next j
For j = 0 To d.Count - 1
Sheets(1).Copy after:=Sheets(1)
Sheets(2).Name = d.keys()(j)
Sheets(2).UsedRange.ClearContents
d.items()(j).EntireRow.Copy Sheets(2).[a1]
Sheets(2).Columns(1).Delete
Call sort_new
Next j
Application.ScreenUpdating = True
End Sub
Sub sort_new()
ActiveSheet.UsedRange.Sort Key1:=Sheets(2).Columns(1), Order1:=1, Header:=xlGuess
End Sub

复制代码

liulang0808 · 发表于 2019-8-23 08:08

附件内容供参考。。。。。。

xaohaz · 发表于 2019-8-23 16:25

liulang0808 发表于 2019-8-23 08:08
附件内容供参考。。。。。。

liulang0808老师，我把工作表1-5删除后，点击“分班”，显示对话框“要求对象”，不知道哪里出错了，麻烦您解答一下，谢谢！
[img][/img]

liulang0808 · 发表于 2019-8-23 19:14

xaohaz 发表于 2019-8-23 16:25
liulang0808老师，我把工作表1-5删除后，点击“分班”，显示对话框“要求对象”，不知道哪里出错了，麻烦 ...

进入模块，运行代码吧
要么设置按钮的宏

xaohaz · 发表于 2019-8-27 13:24

liulang0808 发表于 2019-8-23 19:14
进入模块，运行代码吧
要么设置按钮的宏

好的，谢谢！

		自动登录	找回密码
密码			免费注册

[求助] 根据编号列数字重新分班

朱荣兴朱荣兴当前离线性别保密 UID 1318548 阅读权限 0 注册时间 2011-2-2 在线时间小时最后登录 1970-1-1 积分 19282 财富分享技术精华头像被屏蔽 TA的精华主题 TA的得分主题	发表于 2019-8-23 07:37 \| 显示全部楼层 [广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★使用手册★ 提示: 作者被禁止或删除内容自动屏蔽

	回复举报