[已解决]对号入座分离数据到多工作表的问题

小小玩童

附件 对号入座分离数据.rar (26.38 KB, 下载次数: 11)

2013-6-10 08:52 上传

点击文件名下载附件
谢谢各位老师！

最佳答案

月排行榜 / 总排行榜

lyf7276

2013-6-10 10:04

你把原来的代码改成下面的吧：
Sub 分表()
m = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To m
x = Sheets(1).Range("h" & i)
n = Sheets(x + 1).Cells(Rows.Count, 1).End(xlUp).Row
If Sheets(x + 1).Range("a1") = "" Then
Sheets(1).Range("a" & i & ":h" & i).Copy Sheets(x + 1).Range("a1")
Else
Sheets(1).Range("a" & i & ":h" & i).Copy Sheets(x + 1).Range("a" & n).Offset(1, 0)
End If
Next
End Sub

跳转到最佳答案楼层

lyf7276

你看是这样的吗？ 对号入座分离数据.rar (97.98 KB, 下载次数: 11)

2013-6-10 09:26 上传

点击文件名下载附件

ligh1298

楼主：是不是想要这样的？见附件！

小小玩童

lyf7276 发表于 2013-6-10 09:26
你看是这样的吗？

初步试了一下，思路是正确的。
两个问题：第一，各表的结果，第一行都是空的。应该 不能为空。
第二：把H列后面的东西，也照样移到了各工作表。这样所费的时间将大大超出了想象的范围。

试了一下：18万行数据，要十来分钟。正常情况下，应该很快的。

谢谢老师！

小小玩童

ligh1298 发表于 2013-6-10 09:34
楼主：是不是想要这样的？见附件！
如果你感觉满意，请设置本楼答案为“最佳”，亲！

老师你好，原附件下载后，试了一下正常，但换上18万行数据后，能正常运行，很快，但没结果。

把里面的65536改为1048576后，还是一样，无结果显示。

lyf7276

你把原来的代码改成下面的吧：
Sub 分表()
m = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To m
x = Sheets(1).Range("h" & i)
n = Sheets(x + 1).Cells(Rows.Count, 1).End(xlUp).Row
If Sheets(x + 1).Range("a1") = "" Then
Sheets(1).Range("a" & i & ":h" & i).Copy Sheets(x + 1).Range("a1")
Else
Sheets(1).Range("a" & i & ":h" & i).Copy Sheets(x + 1).Range("a" & n).Offset(1, 0)
End If
Next
End Sub

ligh1298

小小玩童 发表于 2013-6-10 09:53
老师你好，原附件下载后，试了一下正常，但换上18万行数据后，能正常运行，很快，但没结果。

把里面的 ...

你有18万的数据，也是98张表吗？

小小玩童

ligh1298 发表于 2013-6-10 10:23
你有18万的数据，也是98张表吗？

是的，98张表是固定的。18万数据，H列的数，最大也是98。

ligh1298

lyf7276 发表于 2013-6-10 10:04
你把原来的代码改成下面的吧：
Sub 分表()
m = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

是我考虑的太多，以为还要新建表的，就用到了字典。

小小玩童

lyf7276 发表于 2013-6-10 10:04
你把原来的代码改成下面的吧：
Sub 分表()
m = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

18万数据，一般的破电脑在5分钟内能出结果，这代码我看可行。后生可畏啊。
谢谢老师。