如何把一个汇总表按不同内容要求进行拆分，感谢大神。

zf531

因为要每周进行数据汇总后拆分后再发送出去，在拆分时很麻烦，因为数据量太大，店铺多，员多，此时只是展示一部分。原来操作是在汇总数据核对完了后，把汇总表复制成多份，再一个一个改名，再删除不要求的数据。拆成员工姓名发送出去的。很麻烦，有没有什么好的办法可以快速进行拆分？求大神帮帮忙。

汇总表说明：

1.店铺名在这里是进行了合并的，只是为了方便查看，如果为了拆分，可以不合并。

2.一个店铺名只对应一个员工姓名和一个员工号

3.每个店（员工）的销售数量行不固定

4.拆分要求：

1）以员工姓名进行命名表格

2）店铺名填在表头位置

3）只把员工中间的内容进行拆分，每个表的表头、其它说明费用、总价、说明部分保留

4）每个员工的小计自动保留计算。

5）其拆分样例如提供的表。

6）有其它方法能达到也可以帮忙提供。

7）或者，在公司规定的这个员工销售表不能改变基础上，为了拆分，汇总表可以有另外的设计，以此来达到拆分要求？

再次感谢！

zf531

求助大神！！

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long
Dim br()
Dim rn As Range, rng As Range
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 4 Then MsgBox "汇总表为空！": End
    ar = .Range("a2:l" & r - 3)
    Set rn = .Range("a" & r - 2 & ":i" & r)
    Set rng = .Range("a1:i3")
End With
For i = 3 To UBound(ar)
    If ar(i, 10) = "" Then ar(i, 10) = ar(i - 1, 10)
    If ar(i, 12) = "" Then ar(i, 12) = ar(i - 1, 12)
    s = ar(i, 12)
    If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
    d(s)(i) = ""
Next i
Application.SheetsInNewWorkbook = 1
For Each k In d.keys
    n = 0: hj = 0
    ReDim br(1 To d(k).Count, 1 To 9)
    For Each kk In d(k).keys
        n = n + 1
        For j = 1 To 9
            br(n, j) = ar(kk, j)
        Next j
        hj = hj + ar(kk, 8)
    Next kk
    Set wb = Workbooks.Add
    With wb.Worksheets(1)
        .Name = k
        rng.Copy .[a1]
        .[a4].Resize(n, UBound(br, 2)) = br
        .[a4].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
        rn.Copy .Cells(n + 4, 1)
        .Cells(n + 5, 8) = hj
    End With
    wb.SaveAs Filename:=ThisWorkbook.Path & "\" & k & ".xlsx"
    wb.Close
Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

新建文件夹.rar (18.32 KB, 下载次数: 3)

2024-10-31 16:34 上传

点击文件名下载附件

zf531

感谢大神伸出援助之手，我先试一下。

zf531

3190496160 发表于 2024-10-31 16:34

乍用？？感觉不会用，还是没成功？

zf531

我测试了一下，有一点小瑕疵。分表中的公式没有作用了，不方便验收。
表头的店铺名没有填写。
其它的功能都能满足，再次感谢。

3190496160

zf531 发表于 2024-10-31 16:52
我测试了一下，有一点小瑕疵。分表中的公式没有作用了，不方便验收。
表头的店铺名没有填写。
其它的功能 ...

公式就是一个合计，目前的代码已经合计了，没必要再用公式
至于店铺名称等有时间再看看吧

ykcbf1100

参与一下，总表拆分为多工作簿

ykcbf1100

参与一下。。。