拆分后的表格序号重新排序

WZD28

首先感谢gwjkkkkk老师的帮助，程序测试没问题了，非常感谢！
现有2个问题：1、汇总表拆分后各表格序号要求重新排序，不导入原汇总表的序号。2、各表格最后一行填加多一个金额合计，见附图，麻烦各位老师费点心再给修改一下，谢谢！

    拆分02.rar (321.6 KB, 下载次数: 7)

2024-3-2 10:13 上传

点击文件名下载附件

   

gwjkkkkk

原贴中已回复你
https://club.excelhome.net/threa ... tml?_dsign=6348ea39

半百

1. Sub test()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set sh = Sheets("采购计划表")
   
4. arr = sh.UsedRange
   
5. For Each sha In sh.Shapes
   
6.     sha.Placement = xlMoveAndSize
   
7. Next
   
8. For i = 4 To UBound(arr)
   
9.     s = arr(i, 2)
   
10.     d(s) = d(s) + 1
    
11. Next
    
12. For Each k In d.keys
    
13.     sh.Copy after:=Sheets(Sheets.Count)
    
14.     With ActiveSheet
    
15.         .Name = k
    
16.         n = d(k)
    
17.         r = n + 4
    
18.         For j = UBound(arr) To 4 Step -1
    
19.             If .Cells(j, 2) <> k Then
    
20.                 .Rows(j).Delete
    
21.             Else
    
22.                 .Cells(j, 1) = n
    
23.                 n = n - 1
    
24.                 m = m + .Cells(j, 20)
    
25.             End If
    
26.         Next
    
27.         .Cells(r, 19) = "合计"
    
28.         .Cells(r, 20) = m
    
29.         m = 0
    
30.         .Cells(r, 1).Resize(1, UBound(arr, 2)).Borders.LineStyle = 1
    
31.     End With
    
32. Next
    
33. End Sub
    

复制代码

半百