请问怎么按照模板生成EXCEL工作簿？（优化后）

lover826

怎么根据模板表格和数据源，批量生成工作簿？如下图，我要按我的模板，依据日期批量生成100个或者1000个单独工作簿。生成的工作簿保存的时候命名最好带有日期，比如：XXX表2022-11-22（或者在数据源内读取一列作为命名名称都行），麻烦知道的大师教一下，谢谢！
(数据源内包括：姓名列A，走访人列B，工作内容列C即可。)




请帮忙做的表1.rar (17.78 KB, 下载次数: 12)

2022-11-22 16:13 上传

点击文件名下载附件

HSIAOQIANG

VBA或者PYTHON

3190496160

Sub test()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("数据源")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:f" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(ar(i, 1)) = ""
    End If
Next i
For Each k In d.keys
    n = 0
    ReDim br(1 To UBound(ar), 1 To 4)
    For i = 2 To UBound(ar)
        If ar(i, 1) = k Then
            n = n + 1
            br(n, 1) = ar(i, 1)
            br(n, 2) = ar(i, 3)
            br(n, 3) = ar(i, 4)
            br(n, 4) = ar(i, 5)
        End If
    Next i
    Sheets("统计表").Copy
    Set wb = ActiveWorkbook
    With wb.Worksheets(1)
        .[a4].Resize(n, UBound(br, 2)) = br
        .[a4].Resize(n, UBound(br, 2) + 1).Borders.LineStyle = 1
    End With
    wb.SaveAs Filename:=ThisWorkbook.Path & "\走访工作表_" & Format(k, "yyyymmdd")
    wb.Close
Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

数据源.rar (20.48 KB, 下载次数: 44)

2022-11-22 19:20 上传

点击文件名下载附件

lover826

3190496160 发表于 2022-11-22 19:19
Sub test()
Application.ScreenUpdating = False
Dim ar As Variant

感谢！感谢！十分感谢！

tanglf188

就用一个模板，添加按钮读写数据就行啦，1000个模板岂不要看出老花眼

lover826

3190496160 发表于 2022-11-22 19:20

特别的感谢呀，辛苦了！达到了我想要的效果。可否请你在这几行后面加个注解吗? 要完整加注解更好，谢谢！

lover826

tanglf188 发表于 2022-11-23 17:20
就用一个模板，添加按钮读写数据就行啦，1000个模板岂不要看出老花眼

我不会呀，

3190496160

lover826 发表于 2022-11-23 17:50
特别的感谢呀，辛苦了！达到了我想要的效果。可否请你在这几行后面加个注解吗? 要完整加注解更 ...

没有人愿意做注释代码这种枯燥乏味的事情的，除非是有偿

lover826

3190496160 发表于 2022-11-23 18:04
没有人愿意做注释代码这种枯燥乏味的事情的，除非是有偿

嗯嗯，也是，不过确实很感谢你呀！基础比较薄弱，估计你说了我也不一定理解，只是了解一下。