根据E列名称拆分工作表，并建立对应名称的工作表

石来运转6888

根据E列名称拆分工作表，并建立对应名称的工作表，请老师指导，谢谢。

zjdh

你搜索一下“拆分工作表”，有很多帖子可以参考。

baofa2

根据E列名称拆分工作表，并建立对应名称的工作表.zip (30.91 KB, 下载次数: 11)

2024-5-7 11:28 上传

点击文件名下载附件

cyq4896

参与一下...

cyq4896

Sub test()
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
    arr = .[a1].CurrentRegion
    For i = 3 To UBound(arr)
        If Not dic.exists(arr(i, 5)) Then
            Set dic(arr(i, 5)) = .Range("a1:h2")
        Else
            Set dic(arr(i, 5)) = Union(dic(arr(i, 5)), .Cells(i, 1).Resize(1, 8))
        End If
    Next
    End With
    For Each aa In dic.keys
        On Error Resume Next
        Set ws = Sheets(aa)
        If Err <> 0 Then
            Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
            ws.Name = aa
        End If
        With ws
            .Cells.Clear
            dic(aa).Copy ws.Range("a1")
        End With
    Next
End Sub

cidanji

wang-way

1. function Splitdata(){
   
2.         Application.DisplayAlerts=false;//关闭警示
   
3.         let wb=ThisWorkbook;
   
4.         let sht=wb.Worksheets.Item('总表');
   
5.         let hd=sht.Range("a1").CurrentRegion.Value2.slice(0,2);//保存表头数据
   
6.         let ar=sht.Range("a1").CurrentRegion.Value2.slice(2);//读取数据 剔除表头
   
7.         let keys=new Set(ar.map(x=>x[4]));//分行去重
   
8.         for(let k of keys){
   
9.                 //预先删除
   
10.                 try{
    
11.                         wb.Worksheets.Item(k).Delete();
    
12.                 }catch{}
    
13.                 //新建表
    
14.                 let newsht=wb.Worksheets.Add(Before=wb.Worksheets.Item(1));
    
15.                 newsht.Name=k;//根据分行命名
    
16.                 let br=ar.filter(r=>r[4]==k);//筛选分行数据
    
17.                 br.unshift(hd[0],hd[1]);//添加表头
    
18.                 //输出数据
    
19.                 newsht.Range("a1").Resize(br.length,br[0].length).Value2=br;
    
20.                 //首行表头合并单元格
    
21.                 newsht.Range("a1").Resize(1,br[0].length).Merge();
    
22.                 with (newsht.UsedRange){
    
23.                         HorizontalAlignment = xlHAlignCenter;//居中
    
24.                     Borders.ColorIndex = xlColorIndexAutomatic;//边框
    
25.                         Columns.AutoFit()//自动列宽
    
26.                 }
    
27.         }
    
28.         Application.DisplayAlerts=true;//恢复警示
    
29. }

复制代码

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.7
   
2.     Dim arr, d
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Dim tm: tm = Timer
   
7.     Set ws = ThisWorkbook
   
8.     Set sh = ws.Sheets("总表")
   
9.     bt = 2: col = 5
   
10.     For Each sht In Sheets
    
11.         If sht.Name <> sh.Name Then sht.Delete
    
12.     Next
    
13.     arr = sh.UsedRange
    
14.     For i = bt + 1 To UBound(arr)
    
15.         s = arr(i, col)
    
16.         If Not d.Exists(s) Then
    
17.             Set d(s) = CreateObject("scripting.dictionary")
    
18.         End If
    
19.         d(s)(i) = Application.Index(arr, i)
    
20.     Next i
    
21.     For Each k In d.keys
    
22.         If k <> Empty Then
    
23.             sh.Copy after:=Sheets(Sheets.Count)
    
24.             Set sht = Sheets(Sheets.Count)
    
25.             m = d(k).Count
    
26.             With sht
    
27.                 .Name = k
    
28.                 .UsedRange.Offset(m + bt).Clear
    
29.                 .DrawingObjects.Delete
    
30.                 .Cells(bt + 1, 1).Resize(m, UBound(arr, 2)) = Application.Rept(d(k).Items, 1)
    
31.             End With
    
32.         End If
    
33.     Next k
    
34.     sh.Activate
    
35.     Set d = Nothing
    
36.     Application.DisplayAlerts = True
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
39. End Sub
    
40. 
    

复制代码

zpy2

https://e.anyoupin.cn/EData/tree/t/php/split/splitShts.php
工作表拆分
在线工具