一个工作簿里的表格根据部门拆分成不同的工作表

grubby01

各位老师，想问下
把一个工作簿的表格根据部门拆分成不同的工作表，请问如何操作呢，感谢、
比如部门1包含的姓名，职位的表格拆分到一个工作表中，部门1包含的姓名，职位的表格拆分到一个工作表中，请教~~

chxw68

很简单的问题，没有附件怎么写代码？楼主是需要一个思路自己写？

grubby01

chxw68 发表于 2018-3-16 20:25
很简单的问题，没有附件怎么写代码？楼主是需要一个思路自己写？

不好意思~，老师忘记传附件了，也想了解一下解决这个问题的思路，刚刚才开始接触，很多都不懂。。苦手
因为每次表格里的部门人数都是不一致的，固定的代码应该没法用把？

grubby01

附件已经上传了，请老师指导下~

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   With Worksheets("sheet1")
   
9.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
10.     arr = .Range("a1:a" & r)
    
11.     For i = 2 To UBound(arr)
    
12.       If Len(arr(i, 1)) <> 0 Then
    
13.         bm = CStr(arr(i, 1))
    
14.       End If
    
15.       If Not d.exists(bm) Then
    
16.         Set d(bm) = .Range("b1:c1")
    
17.       End If
    
18.       Set d(bm) = Union(d(bm), .Cells(i, 2).Resize(1, 2))
    
19.     Next
    
20.   End With
    
21.   For Each aa In d.keys
    
22.     On Error Resume Next
    
23.     Set ws = Worksheets(aa)
    
24.     If Err Then
    
25.       Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    
26.       ws.Name = aa
    
27.     End If
    
28.     On Error GoTo 0
    
29.     With Worksheets(aa)
    
30.       .Cells.Clear
    
31.       d(aa).Copy .Range("a1")
    
32.     End With
    
33.   Next
    
34. End Sub
    
35. 
    

复制代码

chxw68

详见附件。

grubby01

老师你考虑到真仔细，一种是有分部门的 ，一种没分部门的，2种代码都不太一样，我会好好学习的，感谢~                                                                                                                                                                                                                                                                                                                                                                                 

abc123281

新同学     既然这样   那就快快快送花给老师吧

grubby01

请问怎么 送花呀 。。。我研究了 半天 没找到选项。。