Question

excel中怎么样按某一列的数据自动分成几张表格（要在不同的工作簿中vba）

我在网上找到一段代码能实现一个表中分成几个sheet表，请问怎样能分解成单独几个excel工作簿。
代码：
Sub test()With ActiveSheetr = 2 '数据从第2行开始t = .Cells(r, 3).Value '获取第r行第3列的值即第一个班级名称Do Until t = "" '循环直到获得的单元格内容为空n =Application.WorksheetFunction.CountIf(.Range("c:c"), .Cells(r, 3)) '计算C列第r行第3列单元格的个数Sheets.Add '插入一个新的工作表.Range("a1:d1").Copy Range("a1")'将表头复制到新表.Cells(r, 1).Resize(n, 4).CopyRange("a2") '从第r行第1列开始向右向下扩展n行4列复制到新表的a2r = r + n '获取下一个班级所在行号t = .Cells(r, 3).Value '第2句注释LoopEnd WithEnd Sub

Answer 1

1 下载附件，点击按钮

2 按要求根据C列在本工作簿路径下创建N个工作簿并导入有关数据，新创建的工作簿按班级名称命名

3 不明白hi我

追问

你这个可以，但请问有没有程序，或者创建方法?谢谢！

追答

代码在工作簿中

追问

看不到代码，好像加密了吧!

追答

私信给你

Answer 2

希望能帮到你
Sub 分班() '分班的表格在"我的文档"
Dim k, l, m, s
On Error Resume Next
k = 2
l = 3
m = InputBox("数据最下边一行的行数", , 12)

Do While Cells(l, 3) <> ""
Do While Cells(l, 3) = Cells(k, 3) And l < m
Cells(l, 3).Select
l = l + 1
Loop
s = Cells(l - 1, 3)
Range(Range("c" & l - 1), Range("c" & k)).Select
Selection.EntireRow.Copy
Workbooks.Add
Cells(1, 1) = "姓名"
Cells(1, 2) = "性别"
Cells(1, 3) = "班级"
Cells(1, 2) = "学籍辅号"
Rows("2:2").Select
Selection.Insert Shift:=xlDown
ActiveWorkbook.SaveAs Filename:="班级" & s
ActiveWorkbook.Close
k = l

l = k + 1
Loop
End Sub

Answer 3

可以先建一个模板文件，然后每选一个班级，打开这个模板，写入数据后另存为班级名
Workbooks.Open ThisWorkbook.Path & "\模板.xls"
Set c = ActiveWorkbook
‘写入数据
c.SaveAs ThisWorkbook.Path & "\“ & bjname & ".xls"
c.Close

Answer 4

我也经常遇到这个问题，先是经常需要把数据拆分到各个部门经理，后来又经常要把数据拆分到各个县。
也考虑用VBA实现，结果能实现了，但是因为数据量太大，电脑卡得比人工还慢，最后用python解决了，一分钟不到，完成所有拆分。

Answer 5

把G3改成10，然后在G4中输入：=IF(B4<$G$3,$B$3&",","")&IF(C4<$G$3,$C$3&",","")&IF(D4<$G$3,$D$3&",","")&IF(E4<$G$3,$E$3&",&quo...