求大佬帮忙了，excl如何按照固定模板自动建立表格并填充对应的数据

逆禅寄

如题，手上有一份汇总表，需要根据汇总表的信息分别建工作表或工作簿，里面的对应内容可以自动填充，因为要做的表实在太多（上千份undefined），手动建立属实慢，遂想弄个vba的宏用用，本人vba小白，也想顺便学习下，以后自己写

ykcbf1100

上附件吧，没有附件，啥也干不了。

3190496160

实际上就是一个拆分为工作表或者工作簿的问题，或者上传附件，或者到我的主题里面去找找，几个拆分工具一定有一个适合你的

gwjkkkkk

论坛有很多案例可参考，建议上传附件。。。

3190496160

附件.rar (104.37 KB, 下载次数: 15)

2024-1-26 09:34 上传

点击文件名下载附件

182197315

Sub 分类()
Dim i As Long
Dim j As Long
Dim k As Long
Dim vData As Variant
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet
Dim vKey As Variant
Dim vRlt As Variant
Dim vRow As Variant

vData = Sheet2.Range("A1:D" & Sheet2.Cells(Rows.Count, 4).End(xlUp).Row)
For i = 5 To UBound(vData)
    If Not d.exists(vData(i, 4)) Then
        d(vData(i, 4)) = i
    Else
        d(vData(i, 4)) = d(vData(i, 4)) & "," & i
    End If
Next

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each ws In Worksheets
    ws.Visible = xlSheetVisible
    If ws.Name <> Sheet1.Name And ws.Name <> Sheet2.Name And ws.Name <> Sheet3.Name And ws.Name <> Sheet4.Name Then ws.Delete
Next

For Each vKey In d.keys
    vRow = Split(d(vKey), ",")
    ReDim vRlt(1 To UBound(vRow) + 1, 1 To 3)
    For j = 1 To UBound(vRlt)
        vRlt(j, 1) = vData(vRow(j - 1), 4)
        vRlt(j, 2) = vData(vRow(j - 1), 2)
        vRlt(j, 3) = vData(vRow(j - 1), 3)
    Next

    Sheet1.Copy after:=Worksheets(Worksheets.Count)
    With Worksheets(Worksheets.Count)
        .Name = vKey
        .Range("C3").Resize(UBound(vRlt), 3) = vRlt
    End With
Next

Sheet3.Visible = xlSheetHidden
Sheet4.Visible = xlSheetHidden

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set ws = Nothing
Set d = Nothing
End Sub

182197315

这是附件，请测试

逆禅寄

182197315 发表于 2024-1-26 09:52
这是附件，请测试

谢谢大佬，大体功能能实现，可能我表述的不太明确，我需要的是类似这样的功能（https://www.bilibili.com/video/B ... a907764e887756627ff），可以自定义模板、自动生成该模板并填充数据、然后按特定的要求命名

182197315

逆禅寄 发表于 2024-1-26 12:15
谢谢大佬，大体功能能实现，可能我表述的不太明确，我需要的是类似这样的功能（https://www.bilibili.com ...

建议模板提前收工做好