如何根据C列和E列拆分工作表

lgh978

请教群里的大神：如何根据C列和E列拆分工作表

baofa2

1. Option Explicit
   
2. 
   
3. Sub test0() '
   
4.   Dim dict As Object, wks As Worksheet
   
5.   Dim data, i As Long, j As Long, strKey As String
   
6.   Dim titleRow As Long
   
7.   titleRow = 1  '标题所在 行
   
8.   DoApp False
   
9.   Worksheets("总").Activate
   
10.   For Each wks In Worksheets
    
11.     If wks.Name <> ActiveSheet.Name Then wks.Delete
    
12.   Next
    
13.   Set dict = CreateObject("Scripting.DictionAry")
    
14.   With Range("A1").CurrentRegion
    
15.     j = .Columns.Count
    
16.     data = .Value
    
17.   End With
    
18.   For i = titleRow + 1 To UBound(data)
    
19.     strKey = data(i, 3) & "|" & data(i, 5)
    
20.     If Len(strKey) Then
    
21.       If Not dict.Exists(strKey) Then Set dict(strKey) = Range("A1").Resize(titleRow, j)
    
22.       Set dict(strKey) = Union(dict(strKey), Range("A" & i).Resize(1, j))
    
23.     End If
    
24.   Next
    
25.   For i = 0 To dict.Count - 1
    
26.     With Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
27.       .Name = Replace(dict.Keys()(i), "|", "")
    
28.       dict.Items()(i).Copy .Range("A1")
    
29.       .Columns.AutoFit
    
30.     End With
    
31.   Next
    
32.   Worksheets(1).Activate
    
33.   Set dict = Nothing
    
34.   DoApp
    
35.   Beep
    
36. End Sub
    
37. 
    
38. Function DoApp(Optional b As Boolean = True)
    
39.   With Application
    
40.     .ScreenUpdating = b
    
41.     .DisplayAlerts = b
    
42.     .Calculation = -b * 30 - 4135
    
43.   End With
    
44. End Function
    

复制代码

lgh978

太谢谢了

沈默00

字典嵌套，，经典用法

沈默00

参与一下.....

lgh978

沈默00 发表于 2024-6-6 15:15
参与一下.....

谢谢

lgh978

baofa2 发表于 2024-6-6 13:59

太谢谢了

mjm04

来个函数的

“一语文” 工作表的 A2 单元格：

=FILTER(总!A:E,(总!C:C="一")*(总!E:E="语文"))

其它的替换上面函数的 一  与  语文  的关键字就行

lgh978

mjm04 发表于 2024-6-6 18:19
来个函数的

“一语文” 工作表的 A2 单元格：

谢谢