Question

EXCEL表格处理？

像这样一两万条数据怎么能快速分成一个表一千数据

Answer 1

Sub 拆分表格()

    Dim i&, iBT$, irow&, iNm$, k%

    iBT = InputBox("请输入标题的行数：" & vbLf & vbLf & "如没标题有请填0", "标题行数", 1)

    If iBT = "" Then Exit Sub

    iNm = ActiveSheet.Name

    irow = Range("A" & Rows.Count).End(3).Row

    For i = Val(iBT) + 1 To irow Step 1000

        k = k + 1

        Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = "数据表-" & k

        If Val(iBT) > 0 Then Sheets(iNm).Rows("1:" & iBT).Copy Range("A1")

        Sheets(iNm).Rows(i & ":" & i + 1000 - 1).Copy Range("A" & Val(iBT) + 1)

    Next

    Sheets(iNm).Select

    MsgBox "处理完毕！", , "提示"

End Sub

Answer 2

Excel自带有VBA的，建议用VBA来处理这样的数据。
可以用一个for循环，步长值为1000，每次把一千行数据写入或者复制到新建的工作表中，当然也可以新建工作簿，再把数据写入其中的工作表中并保存成指定规则的名称。
几十万条数据分成几百个表，运行代码可能也就几分钟就完事了。不过写代码需要一些时间的。
思路如上，可参考。

追问

怎么改能，让他的表名自己保存实现升序

追答

图片看不清。

追问

Sub Macro1()
Const num = 1000
i = 1
Do While Range("A" & i).Value ""
Rows(i & ":" & (i + num - 1)).Select
Selection.Copy
Dim wk As Workbook
Set wk = Workbooks.Add
wk.Activate
ActiveSheet.Paste
wk.SaveAs Filename:="E:\未上传\数据表-1.xlsx"
wk.Close
i = i + num
Loop
End Sub

追答

Sub Macro1()
Const num = 1000
i = 1
Do While Range("A" & i).Value ""
Rows(i & ":" & (i + num - 1)).Select
Selection.Copy
Dim wk As Workbook
Set wk = Workbooks.Add
wk.Activate
ActiveSheet.Paste
wk.SaveAs Filename:="E:\未上传\数据表-" & i & ".xlsx"
wk.Close
i = i + num
Loop
End Sub

Answer 3

添加一个辅助列，通过循环序号分类也行，通过其他分类也行。然后，通过数据透视表，可以自动分成多个分表。

Answer 4

新建并打开excel表格，添加数据分析插件，点击左上角按钮，出现菜单页面，选中右下角EXCEL选项按钮，点击之后，然后点击加载项选项，选中分析工具库，点击下方"转到按钮出现excel加载宏界面，在分析工具库前方框内打勾，点击确定,添加数据分析插件，在数据数据分析下可以找到然后点击数据分析，可以找到相关的分析方法，如 回归分析，方差分析，相关分析等。

Answer 5

Sub 拆分()
Dim X, I, R
X = (Range("A65536").End(xlUp).Row - 1) / 1000
For I = 1 To X
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = I
Next
For k = 2 To Range("A65536").End(xlUp).Row Step 1000
n = n + 1
Sheets(n + 1).Select
arr = Range(Cells(k, "a"), Cells(k + 9, "H"))
brr = Range("a1:h1")
Sheets(n + 1).[A1].Resize(1, 8) = brr
Sheets(n + 1).[A2].Resize(10, 8) = arr
Next
End Sub