怎样设置自动分表表头格式保持跟总表一致

黄强黄强

怎样设置自动分表表头格式保持跟总表一致

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim col%, Myr&, Arr, d, k, t, i&, j&, m&, aa
   
3.     Dim Sht As Worksheet
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     Set Sht1 = ActiveSheet
   
8.     For Each Sht In Sheets
   
9.         If Sht.Name <> Sht1.Name And Sht.Name <> "模板" Then Sht.Delete
   
10.     Next Sht
    
11.     col = 3
    
12.     On Error Resume Next
    
13.     Myr = [a65536].End(xlUp).Row
    
14.     Arr = Range("a5:d" & Myr)
    
15.     For i = 1 To UBound(Arr)
    
16.         d(Arr(i, col)) = d(Arr(i, col)) & i & ","
    
17.     Next
    
18.     k = d.keys: t = d.items
    
19.     For i = 0 To UBound(k)
    
20.         Sheet3.Copy after:=Sheets(Sheets.Count)
    
21.         ActiveSheet.Name = k(i): m = 4
    
22.         t(i) = Left(t(i), Len(t(i)) - 1)
    
23.         If InStr(t(i), ",") Then
    
24.             aa = Split(t(i), ",")
    
25.             For j = 0 To UBound(aa)
    
26.                 m = m + 1
    
27.                 Cells(m, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, aa(j), 0)
    
28.             Next
    
29.         Else
    
30.             m = m + 1
    
31.             Cells(m, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, t(i), 0)
    
32.         End If
    
33.     Next
    
34.     Sht1.Activate
    
35.     Set d = Nothing
    
36.     Application.DisplayAlerts = True
    
37.     Application.ScreenUpdating = True
    
38. End Sub
    

复制代码

蓝桥玄霜

请见附件。

黄强黄强

我想要效果是：按“自动分表”按键,最终所生产的表格格式表头同总表的格式一致(如丁，甲，丙，寅，壬，癸，庚，……等），请各位楼主修改，多谢。（见附件）

LMY123

d(Arr(i, col)) = d(Arr(i, col)) & i & ","