【有偿求助】请问如何根据部门列自动生成新的部门sheet，实现数据同步

waitfly

请问如何根据部门列自动生成新的部门sheet，然后这里添加新的数据的时候，部门sheet里面也会自动增加
在线等。。
V5286808

2489586288

联系方式多少

waitfly

2489586288 发表于 2017-11-25 09:53
联系方式多少

微信号：5286808

鄂龙蒙

1. Sub 按D列内容拆分成多表()
   
2.     Application.DisplayAlerts = False
   
3.     Dim sh As Worksheet
   
4.     Dim d As Object
   
5.     Dim arr As Variant
   
6.     Dim i, x
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.         For Each sh In Worksheets
   
9.             If sh.Name <> "表1" Then
   
10.                 sh.Delete
    
11.             End If
    
12.         Next sh
    
13.     arr = Sheet1.[A1].CurrentRegion
    
14.         For i = 2 To UBound(arr)
    
15.             If Not d.exists(arr(i, 4)) Then
    
16.                 Set d(arr(i, 4)) = Sheet1.Range("a" & i).Resize(1, UBound(arr, 2))
    
17.             Else
    
18.                 Set d(arr(i, 4)) = Union(d(arr(i, 4)), Sheet1.Range("a" & i).Resize(1, UBound(arr, 2)))
    
19.             End If
    
20.         Next i
    
21.     x = d.keys
    
22.         For i = 0 To UBound(x)
    
23.             Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
    
24.             sh.Name = x(i)
    
25.             Sheet1.[A1:V1].Copy sh.[A1]
    
26.             d.items()(i).Copy sh.[A2]
    
27.         Next i
    
28.     Application.DisplayAlerts = True
    
29. End Sub
    

复制代码