怎么根据模板和数据批量生成新的excel文件

justus8735 · 发表于 2014-12-11 16:44

本帖最后由 justus8735 于 2014-12-11 16:48 编辑

因为工作的原因，需要把几千个客户的资料制作成相应的规定格式的excel文件。
现在手上有excel文件的模板，求教怎么批量生成。

就是说比如模板的D3要填姓名，数据的A列是姓名，然后把数据A列的内容填在D3处，然后其他的地方也是照这样对应。最后生成一个新的excel文件，新文件只有一个工作表，表名是相同的，文件名就是姓名。

需求.rar (124.78 KB, 下载次数: 244)

yangjia1980 · 发表于 2014-12-11 16:52

这个我觉得有个比较简单的办法
你录一个宏，生成一个样本
然后把宏改一下，应该就可以了
你先试试

dqhtju · 发表于 2014-12-11 17:07

试试看

Sub TEST()
arr = Sheets("Sheet2").[a1].CurrentRegion
r = UBound(arr, 1)
For i = 2 To r
Sheets("指标new").Copy After:=Sheets(2)
With Sheets("指标new (2)")
.[E7] = arr(i, 1)
.[E8] = arr(i, 2)
.[E9] = arr(i, 3)
.[E13] = arr(i, 4)
.[E14] = arr(i, 5)
.[E15] = arr(i, 6)
.Name = arr(i, 1)
End With
Next
End Sub

复制代码

justus8735 · 发表于 2014-12-11 17:18

dqhtju 发表于 2014-12-11 17:07
试试看

你好，谢谢您的指导。
确实是能生成新的sheet。
不过可能我没说清楚我的意思，我是想生成一个新的excel文件，文件只包括“指标new”这个sheet，然后文件名是姓名，sheet名还是“指标new”

谢谢您了~

dqhtju · 发表于 2014-12-11 21:49

Sub TEST()
arr = Sheets("Sheet2").[a1].CurrentRegion
r = UBound(arr, 1)
For i = 2 To r
With Sheets("指标new")
.[E7] = arr(i, 1)
.[E8] = arr(i, 2)
.[E9] = arr(i, 3)
.[E13] = arr(i, 4)
.[E14] = arr(i, 5)
.[E15] = arr(i, 6)
End With
Sheets("指标new").Copy
ActiveWorkbook.SaveAs Filename:="C:\Users\Administrator\Desktop" & arr(i, 1) & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Next
End Sub

复制代码

q2369182 · 发表于 2018-11-15 12:37

mark 日后学习

cjc209 · 发表于 2018-11-15 13:24

通用型代码把模板单独存为模板工作薄然后打开数据源粘贴代码按操作提示进行就可以了只需动动鼠标接下来就自动运行等待结果

Sub 批量导出到模板()
Dim myPath, myName
Dim arr As Variant
Dim i, s As Integer, arr2(), arr1()
Dim wb As Workbook
Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择保存结果文件的存放目录：", &H1)
If Not Mapp Is Nothing Then
Directory = Mapp.self.Path
Else
MsgBox "你没有选择保存目录！": Exit Sub
End If
Set zsj = Application.InputBox("请点选：数据源中的任意非空单元格", Type:=8)
Set zdm = Application.InputBox("请在该表中点选或者框选匹配需要的：字段名", Type:=8)
zdmhh = Val(Application.InputBox("请输入字段名所处的行号为数字型 1 2 3 ..."))
arr = zsj.CurrentRegion.Offset(zdmhh - 1, 0)
gzbm = Application.InputBox("请点选：以什么字段名来命名新工作簿", Type:=8)
For Each zdm1 In zdm
nn = nn + 1
ReDim Preserve arr1(1 To nn)
arr1(nn) = zdm1.Value
Next
myPath = ThisWorkbook.Path & "\*.xls*"
myName = Dir(myPath)
Do While myName <> ""
If myName <> ThisWorkbook.Name Then mbbm = myName
myName = Dir()
Loop
Set wb = Workbooks.Open(ThisWorkbook.Path & "" & mbbm)
For Each Rng In arr1
tt = "原始数据中的 " & Rng & " 列匹配到模板中的对应位置："
n = n + 1
If Rng = gzbm Then
bmxh = n
End If
Set tishi = Application.InputBox(tt, Type:=8)
ReDim Preserve arr2(1 To n)
arr2(n) = tishi.Address(0, 0)
Next Rng
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To UBound(arr)
With wb.Worksheets(1)
For j = 1 To UBound(arr2)
For k = 1 To UBound(arr, 2)
If arr1(j) = arr(1, k) Then
.Range(arr2(j)) = arr(i, j)
End If
Next
Next
.Copy
bm = arr(i, bmxh)
If bm <> "" Then
ActiveWorkbook.SaveAs Filename:=Directory & "" & bm & ".xls"
End If
ActiveWorkbook.Close
End With
Next i
wb.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "导出完毕！"
End Sub

复制代码

q2369182 · 发表于 2018-11-17 19:47

cjc209 发表于 2018-11-15 13:24
通用型代码把模板单独存为模板工作薄然后打开数据源粘贴代码按操作提示进行就可以了只需动动鼠标接下来 ...

空白模板和汇总好的信息放在同一个文件夹下？
数据源就是汇总好的信息？
点选或者框选匹配需要的字段名是什么东西？

雨焰 · 发表于 2020-1-12 01:01

dqhtju 发表于 2014-12-11 17:07
试试看

Sheets("指标new").Copy After:=Sheets(2)
为什么上面sheets后括号里面填的是2呢？
有点想不明白，因为复制了指标new后，产生的新工作表指标new()括号中应该是一个会变的值。

andypau · 发表于 2020-2-28 17:21

看题目类似的问题是很多，只是高手解答太少了，希望多点简便易懂的答案。。

		自动登录	找回密码
密码			免费注册

[求助] 怎么根据模板和数据批量生成新的excel文件