如何根据两个工作表中的关键列班级类别和报考专业和工作表名生成分工作表名分班级...

yzyyyyyyy

照顾对象：关键列班级，类别

特长生：关键列班级，报考专业
目标表：分别根据两个工作表关键列生成名单，每行超过2人折行，之间加空行
统计表：分工作表，分班级和类别生成人数 如何根据两个工作表中的关键列班级类别和报考专业和工作表名生成分工作表名分班级各类.rar (12.99 KB, 下载次数: 20)

2024-5-11 15:51 上传

点击文件名下载附件

chxw68

写这样的代码能把人逼疯。

蓝桥玄霜

照顾的例子：

yzyyyyyyy

chxw68 发表于 2024-5-11 20:55
写这样的代码能把人逼疯。

感谢大师热心帮助，大师说的极是，代码要求逻辑强，细节环节个个相扣，真使人崩溃

chxw68

练练手。。

yzyyyyyyy

chxw68 发表于 2024-5-12 20:56
练练手。。

感谢大师热心帮助，圆满解决一大难题。大师有时间，麻烦再看一下生成统计表，谢谢大师

chxw68

yzyyyyyyy 发表于 2024-5-13 08:58
感谢大师热心帮助，圆满解决一大难题。大师有时间，麻烦再看一下生成统计表，谢谢大师

统计表这么简单的问题，你自己写吧。

yzyyyyyyy

chxw68 发表于 2024-5-13 10:46
统计表这么简单的问题，你自己写吧。

感谢大师热心帮助，真的不简单，实在写不出来，大师有时间麻烦再看一下吧，谢谢

chxw68

1. Sub test3()
   
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.     Set d1 = CreateObject("scripting.dictionary")
   
9.     vs = [{"照顾对象",1,2,3;"特长生",3,8,1}]
   
10.     For k = 1 To UBound(vs)
    
11.         Set d(vs(k, 1)) = CreateObject("scripting.dictionary")
    
12.         Set d1(vs(k, 1)) = CreateObject("scripting.dictionary")
    
13.         With Worksheets(vs(k, 1))
    
14.             r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.             c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
16.             arr = .Range("a2").Resize(r - 1, c)
    
17.             n = 2
    
18.             For i = 1 To UBound(arr)
    
19.                 If Not d1(vs(k, 1)).exists(arr(i, vs(k, 3))) Then
    
20.                     n = n + 1
    
21.                     d1(vs(k, 1))(arr(i, vs(k, 3))) = n
    
22.                 End If
    
23.             Next
    
24.             ls = n
    
25.             For i = 1 To UBound(arr)
    
26.                 If Not d(vs(k, 1)).exists(arr(i, vs(k, 2))) Then
    
27.                     ReDim brr(1 To ls)
    
28.                     brr(1) = arr(i, vs(k, 2))
    
29.                 Else
    
30.                     brr = d(vs(k, 1))(arr(i, vs(k, 2)))
    
31.                 End If
    
32.                 n = d1(vs(k, 1))(arr(i, vs(k, 3)))
    
33.                 brr(n) = brr(n) + 1
    
34.                 brr(2) = brr(2) + 1
    
35.                 d(vs(k, 1))(arr(i, vs(k, 2))) = brr
    
36.             Next
    
37.         End With
    
38.     Next
    
39.     With Worksheets("统计表")
    
40.         .Cells.Clear
    
41.         r = 1
    
42.         For Each aa In d.keys
    
43.             .Cells(r, 1) = "班级"
    
44.             With .Cells(r, 3)
    
45.                 .Value = aa
    
46.                 .Resize(1, d(aa).Count).Merge
    
47.             End With
    
48.             .Cells(r + 1, 3).Resize(1, d1(aa).Count) = d1(aa).keys
    
49.             ReDim crr(1 To d(aa).Count, 1 To 2 + d1(aa).Count)
    
50.             ReDim drr(1 To 2 + d1(aa).Count)
    
51.             drr(1) = "合计"
    
52.             m = 0
    
53.             For Each bb In d(aa).keys
    
54.                 brr = d(aa)(bb)
    
55.                 m = m + 1
    
56.                 For j = 1 To UBound(brr)
    
57.                     crr(m, j) = brr(j)
    
58.                 Next
    
59.                 For j = 2 To UBound(brr)
    
60.                     drr(j) = drr(j) + brr(j)
    
61.                 Next
    
62.             Next
    
63.             .Cells(r + 2, 1).Resize(1, UBound(drr)) = drr
    
64.             .Cells(r + 3, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
    
65.             With .Cells(r, 1).Resize(3 + UBound(crr), UBound(crr, 2))
    
66.                 .Borders.LineStyle = xlContinuous
    
67.                 With .Font
    
68.                     .Name = "微软雅黑"
    
69.                     .Size = 10
    
70.                 End With
    
71.             End With
    
72.             .Columns(1).Resize(, UBound(crr, 2)).AutoFit
    
73.             r = r + 2 + UBound(crr) + 3
    
74.         Next
    
75.         With .UsedRange
    
76.             .HorizontalAlignment = xlCenter
    
77.             .VerticalAlignment = xlCenter
    
78.         End With
    
79.     End With
    
80. End Sub
    

复制代码

chxw68

写好了。哪个写起来都别扭。