20170727xlVBA根据数据表和模板工作簿生成个人明细表工作簿
Sub CreateTables() Dim Wb As Workbook Dim OpenWb As Workbook Dim Sht As Worksheet Dim Rng As Range Dim Arr As Variant Dim i As Long Const HEAD_ROW As Long = 2 Dim EndRow As Long '模板文件名和路径 Const ModelName As String = "社+名.xlsx" Dim ModelPath As String '生成文件名和路径 Dim NewName As String Dim NewPath As String Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets("明细表") ModelPath = Wb.Path & "\模板\" & ModelName '社+名的完整路径 With Sht EndRow = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row '内置方法,返回A列最后一个非空单元格行号 Set Rng = .Range(.Cells(HEAD_ROW + 1, "A"), .Cells(EndRow, "I")) '引用区域,左上角单元格,右下角单元格,这样就获取数据区域了 自己领悟一下就知道了 Arr = Rng.Value '存在一个数组里面,这样速度好很多 '和单元格区域是一样的。只是它只有数据,没有框框颜色字体什么的,所以用起来很快 Set OpenWb = Application.Workbooks.Open(ModelPath) '打开模板文件 For i = LBound(Arr) To UBound(Arr) '从第一行到最后一行,逐行循环 'arr相当于是一个有行列结构的数组,和单元格区域是一样的。Lbound可以取到开始行,Ubound可以取到结束行 '开始构建新文件名 NewName = Arr(i, 9) & "-" & Arr(i, 2) & ".xlsx" 'i是可变的,9就是第I列 经办行,2就是第B列的客户名称,新文件名就弄好了 NewPath = Wb.Path & "\生成\" & NewName '新文件名的完整路径 就构造好了 '开始填表 '这里就做两个示范,剩下的你自己填就知道了 '第一个sheet OpenWb.Worksheets("(一)档案封皮").Range("B13").Value = Arr(i, 2) '借款人 OpenWb.Worksheets("(一)档案封皮").Range("A23").Value = Arr(i, 9) '经办行 OpenWb.Worksheets("(二)债务主体认定书").Range("B4").Value = Arr(i, 2) '经办行 OpenWb.Worksheets("(二)债务主体认定书").Range("B5").Value = "'" & Arr(i, 1) '贷款号 '注意注意注意 长数字 前面一定要加上 "'" & ,这样防止后面三位数字变成 000 '************剩下自己弄 OpenWb.SaveCopyAs NewPath '填完就另存副本 Next i OpenWb.Close False '关掉模板 End With '释放对象,告诉内存,这些东东我不要了,不然一直占着内存 Set Wb = Nothing Set OpenWb = Nothing Set Sht = Nothing Set Rng = Nothing Erase Arr '擦除数组 End Sub