使用VBA给EXCEL处理数据

桐羽sama

想要处理一大段的数据资料，有若干行和94列，第一行是表头，第一列是每一行数据的编号，一个编号对应多条信息，例如：

10001	20161208100000	2415	10725	0
10001	20161208120000	2415	10725	0
10001	20161208130000	2415	10725	0
10001	20161208140000	2415	10725	0
10002	20161208100000	229183	1109949	0
10002	20161208120000	229183	1109949	0
10002	20161208130000	229183	1109949	0
10002	20161208140000	229183	1109949	0
10003	20161208100000	233943	1100793	0
10003	20161208120000	233943	1100793	0
10003	20161208130000	233943	1100793	0
10003	20161208140000	233943	1100793	0
10004	20161208100000	2269	10920	0
10004	20161208120000	2269	10920	0

往后内容还有很多，包括编号在内的一共有94列数据，希望把这些数据全部分开按照编号分别转移到分页10001,10002,10003等等分页中，以下是在网上找到并修改的代码，提示情况是下标越界，但是小白真的不是很懂这个东西，希望各位老师帮忙看看代码有什么问题，如何修改：
Public Sub split1()
Dim x As Range, rng As Range
Sheets(1).Select
For Each x In Range([a2], [a65536].End(3))
    If Application.Match(x, [a:a], 0) = x.Row Then
        Set rng = x.Offset(, 1).Resize(Application.CountIf([a:a], x) - 1, 94)
        If Sheets(x.Value).[b1] = "" Then
            Sheets(x.Value).[b1:cp1] = Sheets(1).[b1:cp1].Value
            Sheets(x.Value).[b2].Resize(rng.Rows.Count, 94) = rng.Value
        Else
            Sheets(x.Value).[b65536].End(3).Offset(1).Resize(rng.Rows.Count, 94) = rng.Value
        End If
    End If
Next
End Sub

桐羽sama

先谢谢各位老师了。。。

lsc900707

请压缩打包上传你的数据文件

桐羽sama

这里是附件

桐羽sama

朱荣兴 发表于 2017-3-3 14:08
典型的拆分问题，楼主有没有附件，看看这个帖子吧
http://club.excelhome.net/thread-1317595-1-1.html

老师您好，附件已经在5楼上传了，感谢老师

桐羽sama

lsc900707 发表于 2017-3-3 14:40
请压缩打包上传你的数据文件

老师你好，附件在5楼已经上传，谢谢老师的帮忙

lsc900707

桐羽sama 发表于 2017-3-3 14:53
老师你好，附件在5楼已经上传，谢谢老师的帮忙

代码放sheet1代码区，按钮用控件按钮：
Private Sub CommandButton1_Click()
    Dim tim1 As Date, tim2 As Date: tim1 = Timer
    Dim arr, d As Object, sh As Worksheet
    Set d = CreateObject("scripting.dictionary")
    arr = Range("a1").CurrentRegion
    For I = 1 To UBound(arr)
        If Not d.exists(arr(I, 1)) Then
            Set d(arr(I, 1)) = Range("a" & I).Resize(1, 94)
        Else
            Set d(arr(I, 1)) = Union(d(arr(I, 1)), Range("a" & I).Resize(1, 94))
        End If
    Next I
    x = d.keys
    For k = 1 To UBound(x)
        Set sh = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)
        sh.Name = x(k)
        d.items()(k).Copy sh.Range("a" & 2)
        Rows("1:1").Copy sh.Range("a1")
    Next k
    tim2 = Timer
    MsgBox Format(tim2 - tim1, "拆分完成，共耗时：0.00秒"), 64, "时间统计"
End Sub

桐羽sama

lsc900707 发表于 2017-3-3 16:02
代码放sheet1代码区，按钮用控件按钮：
Private Sub CommandButton1_Click()
    Dim tim1 As Date, ti ...

老师，您好，出现的是1004错误，是我什么地方操作失误导致的吗？

lsc900707

桐羽sama 发表于 2017-3-3 16:21
老师，您好，出现的是1004错误，是我什么地方操作失误导致的吗？

把除sheet1以外的表先行删除