求助 用代码分工作簿数据
vb吧
全部回复
仅看楼主
level 3
saltfish.1 楼主
在一个工作簿中,如何将里面的数据 每20行就另存为一个新的工作博,并且都在每个工作簿第一行加上相同的标题,得到的工作薄依次命名为1,2,3,......
2020年12月08日 07点12分 1
level 13
'假设你的原始工作簿为:D:\原始工作簿.xlsx,你需要处理的数据位于第一个sheet中的“A2:G93”区域
Private Sub Command1_Click()
Dim i&, j&, k&
Dim xData() As Variant
Dim Temp() As String
Dim xTitle() As String
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
'创建excel对象
Set xlApp = CreateObject("Excel.Application")
'打开原始工作簿
Set xlBook = xlApp.workbooks.open("D:\原始工作簿.xlsx")
'获取第一个sheet中指定区域的数据,存入数组
xData = xlBook.sheets(1).range("A2:G93").Value
'原始工作簿不需要了,关闭
xlBook.Close
Set xlBook = Nothing
'定义你要在每个表格中填写的标题行,例如:
ReDim xTitle(1 To 1, 1 To 7)
xTitle(1, 1) = "序号"
xTitle(1, 2) = "姓名"
xTitle(1, 3) = "性别"
xTitle(1, 4) = "年龄"
xTitle(1, 5) = "学号"
xTitle(1, 6) = "成绩"
xTitle(1, 7) = "备注"
'按每20行数据进行分割,转存temp数组
For i = 1 To UBound(xData, 1) \ 20
ReDim Temp(1 To 20, 1 To UBound(xData, 2))
For j = 1 To 20
For k = 1 To UBound(xData, 2)
Temp(j, k) = xData((i - 1) * 20 + j, k)
Next
Next
Set xlBook = xlApp.workbooks.Add
xlBook.saveas "D:\" & i & ".xlsx"
'在新的工作簿中写入标题行
xlBook.sheets(1).range("A1:G1").Value = xTitle
'将temp数组写入新的工作簿并保存
xlBook.sheets(1).range("A2:G21").Value = Temp
xlBook.SAVE
xlBook.Close
Set xlBook = Nothing
Next
'分割到最后剩下的数据可能不足20行,对此部分数据进行单独处理:
ReDim Temp(1 To 20, 1 To UBound(xData, 2))
For j = 1 To UBound(xData, 1) Mod 20
For k = 1 To UBound(xData, 2)
Temp(j, k) = xData((i - 1) * 20 + j, k)
Next
Next
Set xlBook = xlApp.workbooks.Add
xlBook.saveas "D:\" & i & ".xlsx"
xlBook.sheets(1).range("A1:G1").Value = xTitle
xlBook.sheets(1).range("A2:G21").Value = Temp
xlBook.SAVE
xlBook.Close
Set xlBook = Nothing
'释放excel对象
xlApp.quit
Set xlApp = Nothing
MsgBox "分割完毕"
End Sub
2020年12月08日 13点12分 3
兄弟 你真给力 谢谢你[大拇指]
2020年12月09日 02点12分
1