[已解决]报表拆分

炽天使520

总表中的数据，按照分类全部拆分到各sheet中，在总表中添加删除数据，分表中自动更改。详见附件。谢谢！

最佳答案

月排行榜 / 总排行榜

chart888

2017-5-13 16:30

炽天使520 发表于 2017-5-13 16:17
可以用我中文名称的那个类别吗？用代码的话不宜查找。

你把类别里面只填写中文名
不要写代码
就可以了
我修改了代码

跳转到最佳答案楼层

qqyyh

工作簿1.rar (29.45 KB, 下载次数: 3)

2017-5-13 14:11 上传

点击文件名下载附件

chart888

1. Private Sub CommandButton1_Click()
   
2. On Error Resume Next
   
3. 
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Dim Arr, Rng As Range, Sht As Worksheet, Dic As Object
   
7. Dim k, t, Str As String, i As Long, lc As Long
   
8. 
   
9. Arr = ThisWorkbook.Worksheets("总表").Range("A3").CurrentRegion.Value
   
10. lc = UBound(Arr, 2)
    
11. Set Rng = Rows(2)
    
12. Set Dic = CreateObject("Scripting.Dictionary")
    
13. For i = 3 To UBound(Arr)
    
14.     Str = Arr(i, 5)
    
15.         If Not Dic.Exists(Str) Then
    
16.             Set Dic(Str) = Cells(i, 1).Resize(, lc)
    
17.         Else
    
18.             Set Dic(Str) = Union(Dic(Str), Cells(i, 1).Resize(, lc))
    
19.         End If
    
20. Next
    
21.     k = Dic.Keys
    
22.     t = Dic.Items
    
23. With Sheets
    
24.     For i = 0 To Dic.Count - 1
    
25.         Set Sht = .Item(k(i))
    
26.             If Sht Is Nothing Then
    
27.                 .Add(After:=.Item(.Count)).Name = k(i)
    
28.                 Set Sht = ActiveSheet
    
29.             Else
    
30.                 Sht.Cells.Clear
    
31.             End If
    
32.     Rng.Copy Sht.Range("A1")
    
33.     t(i).Copy Sht.Range("A2")
    
34.     Sht.Cells.EntireColumn.AutoFit
    
35.     Set Sht = Nothing
    
36. Next
    
37. End With
    
38. Sheets(1).Activate
    
39. 
    
40. Application.ScreenUpdating = True
    
41. Application.DisplayAlerts = True
    
42. End Sub
    

复制代码

炽天使520

chart888 发表于 2017-5-13 15:11

可以用我中文名称的那个类别吗？用代码的话不宜查找。

chart888

炽天使520 发表于 2017-5-13 16:17
可以用我中文名称的那个类别吗？用代码的话不宜查找。

什么意思？每看懂

chart888

炽天使520 发表于 2017-5-13 16:17
可以用我中文名称的那个类别吗？用代码的话不宜查找。

你把类别里面只填写中文名
不要写代码
就可以了
我修改了代码

mafia

换了一种写法，更简单一些


参考帖子：http://c.raqsoft.com.cn/article/1607325308043