女侠 香川群子 为高难问题提供了绝妙思路和经典公式！请大家参照学习！祝国庆快乐！！

aaaaaa123459

怀英慕者 发表于 2011-10-2 23:58
很不明白为什么要放弃便利的工具VBA，却要想方设法编复杂的公式？如果楼主是想做个一劳永逸的数据表，复杂公 ...

你好！
    谢谢你的参与，你的话很有道理，我来解释一下，我只所以限制VBA,有两点思考：
    其一，考虑到才能极限
          这个问题用VBA太简单了，不能体现出这方面的才能。
          你试想一下，如果这个问题能不用VBA和辅助列完美解决，具有这样能力的人，使用BVA解决这样的问题不是小菜一碟吗？但反过来却不是这样，会编写VBA解决这个问题的人大有人在，但不一定意味着他们会用纯粹的统一公式解决这个问题。
          实际上这样做即是在检验人们对Excel的使用能力，也是在逼近excel的能力极限，如果公之于世的话，说不定微软知道了，会促进excel的升级，进而促进世界的发展呢！说远了。
           所以简单地用VBA解决问题，不能推进人们才情的进步。
      其二，考虑到创新的普适性
        用VBA编程的人再多，也多不过会只会用公式的人，按照80：20的普世原则，如果用VBA解决问题，对绝大多数连公式都不会用，VBA更是不明白的人来说，犹如天外来音，虽然高效，但终因曲高和寡而缺乏知音，对其使用的推广，带来了极大的不便；即使推广了，也只能是傻瓜式的模式，造成人们对固有模式的依赖，而不能增强人们的参与创新意识，不利于中国创新式社会的构建。又说远了，总之用公式的人还是比较多的，用公式带来的便利会让更多的人投入到学习中来，进而促进人们的创新参与意识，相对直接提供给人们一个功能模板让人依赖，不是更有利于社会的进步吗？
        当然，如果能以很多人都使用过的公式为跳板，在公式的神奇功能与VBA的高效对比中，让多数认识到VBA的魅力，进而加入到近几乎会公式都学习编程的大潮中，对于全民建设创新型国家，岂不是一件快人心的幸事！
      考虑不周之处，请谅解！

sahjq

这个题目有一定的难道。

天堑小舟

这不是工作吧,只能定性为学习!
学习了,谢谢!

怀英慕者

aaaaaa123459 发表于 2011-10-3 04:32
怀英慕者 发表于 2011-10-2 23:58
很不明白为什么要放弃便利的工具VBA，却要想方设法编复杂的公式？如果楼 ...

你可以做个调查，凡是来VBA模块的朋友大多是因为函数和公式已经阻碍了他们工作的人，换句话说，他们以前都是用函数和公式的。我并不反对研究函数公式，因为工作的目的是解决问题，而不是不分情况的挑战问题。如果你的问题很简单，数据量很小，那么用函数就很方便了，反而用vba是种浪费。反之，明明知道工作是繁重的，偏要用函数，虽然解决了，可是却效率低下，那么就失去了excel作为一种工具的意义。
打个比方，你打算去北京，可以坐汽车去，可是偏要骑自行车，说是要无限的挑战自行车的潜能，要让自行车公司明白他们的缺陷以促进其改进，你觉得他会改进吗？
肯定不会。凡事要理智思维，工具只是为我们工作而服务，我们却不能被工具牵着鼻子走。

aaaaaa123459

怀英慕者 发表于 2011-10-3 10:00
你可以做个调查，凡是来VBA模块的朋友大多是因为函数和公式已经阻碍了他们工作的人，换句话说，他们以前都 ...

谢谢你的参与，明白你的意思，再次感谢！
       只是我觉得，软件与硬件不太相同，软件的潜力是无限的，而硬件却做不到，所以我相同自行车永远比不过汽车，同时自行车的改进也不会对人类交通能力的提升有多大帮助，最多只是环保而已，但软件却不同。
      不用调查，我也相信你说的凡是来VBA模块的朋友大多是因为函数和公式已经阻碍了他们工作的人，但我也相信，在同样VBA编程能力的条件下，公式函数能力越强的人编程能力越高；
        还有就是在VBA中，如果没有强大的函数支持，VBA只是一个花架子空壳，每个学习VBA的人在之前都要过函数公式关的。对函数公式的理解和运用极大地影响了其VBA的编程能力。很多人正如你所言，达到了公式函数的极限才去选择VBA的高效，两者并不冲突，而是相互促进的，所以我在这里专门挑战大家的函数公式能力，并不影响会VBA人士的编程能力，而如果能挑战成功的话，也会促进其对VBA中部分函数公式的理解，虽然VBA中的函数与工作表中的不尽相同。

香川群子

这个题目用VBA也不是很简单的说。

下面的VBA代码，使用了词典嵌套。（数组是当然的了）

1. Sub test()
   
2.     tm = Timer
   
3.     Application.ScreenUpdating = False
   
4.     Sheet2.Activate
   
5.     arr = [a1:j1765]
   
6.     Set dbz = CreateObject("Scripting.Dictionary")
   
7.     Set ddy = CreateObject("Scripting.Dictionary")
   
8.    
   
9.     For i = 2 To UBound(arr)
   
10.         If Not dbz.Exists(arr(i, 2)) Then Set dbz(arr(i, 2)) = CreateObject("Scripting.Dictionary")
    
11.         dbz(arr(i, 2))(arr(i, 3)) = arr(i, 6)
    
12.         
    
13.         If Not ddy.Exists(arr(i, 1)) Then Set ddy(arr(i, 1)) = CreateObject("Scripting.Dictionary")
    
14.         ddy(arr(i, 1))(arr(i, 3)) = arr(i, 5)
    
15.     Next
    
16.    
    
17.     cb = dbz.Count
    
18.     bz = dbz.Keys
    
19.     ReDim bzf(cb - 1, 4)
    
20.     For i = 0 To dbz.Count - 1
    
21.         bzf(i, 0) = dbz(bz(i)).Items
    
22.         bzf(i, 1) = bz(i)
    
23.         bzf(i, 2) = WorksheetFunction.Large(bzf(i, 0), 50)
    
24.         [t1].Resize(UBound(arr)) = WorksheetFunction.Transpose(bzf(i, 0))
    
25.         bzf(i, 3) = 50 - WorksheetFunction.CountIf([t1].Resize(UBound(arr)), ">" & bzf(i, 2))
    
26.         dbz(bz(i)) = i
    
27.     Next
    
28.    
    
29.     cd = ddy.Count
    
30.     dy = ddy.Keys
    
31.     ReDim dyf(cd - 1, 6)
    
32.     For i = 0 To ddy.Count - 1
    
33.         dyf(i, 0) = ddy(dy(i)).Items
    
34.         dyf(i, 1) = dy(i)
    
35.         dyf(i, 2) = WorksheetFunction.Large(ddy(dy(i)).Items, 60)
    
36.         dyf(i, 3) = WorksheetFunction.Large(ddy(dy(i)).Items, 180)
    
37.         [t1].Resize(UBound(arr)) = WorksheetFunction.Transpose(dyf(i, 0))
    
38.         dyf(i, 4) = 60 - WorksheetFunction.CountIf([t1].Resize(UBound(arr)), ">" & dyf(i, 2))
    
39.         dyf(i, 5) = 180 - WorksheetFunction.CountIf([t1].Resize(UBound(arr)), ">" & dyf(i, 3))
    
40.         ddy(dy(i)) = i
    
41.     Next
    
42.     [t1].Resize(UBound(arr)).Clear
    
43.    
    
44.     For i = 2 To UBound(arr)
    
45.         If arr(i, 6) > bzf(dbz(arr(i, 2)), 2) Then
    
46.             arr(i, 7) = 1
    
47.             bzf(dbz(arr(i, 2)), 4) = bzf(dbz(arr(i, 2)), 4) + 1
    
48.         ElseIf arr(i, 6) = bzf(dbz(arr(i, 2)), 2) Then
    
49.             If bzf(dbz(arr(i, 2)), 3) > 0 Then
    
50.                 arr(i, 7) = 50 - bzf(dbz(arr(i, 2)), 3) + 1
    
51.                 bzf(dbz(arr(i, 2)), 3) = bzf(dbz(arr(i, 2)), 3) - 1
    
52.                 bzf(dbz(arr(i, 2)), 4) = bzf(dbz(arr(i, 2)), 4) + 1
    
53.             End If
    
54.         End If
    
55.         
    
56.         If arr(i, 5) < dyf(ddy(arr(i, 1)), 2) And arr(i, 5) > dyf(ddy(arr(i, 1)), 3) Then
    
57.             arr(i, 8) = 1
    
58.             dyf(ddy(arr(i, 1)), 6) = dyf(ddy(arr(i, 1)), 6) + 1
    
59.         ElseIf arr(i, 5) = dyf(ddy(arr(i, 1)), 2) Then
    
60.             dyf(ddy(arr(i, 1)), 4) = dyf(ddy(arr(i, 1)), 4) - 1
    
61.             If dyf(ddy(arr(i, 1)), 4) <= 0 Then
    
62.                 arr(i, 8) = 60 - dyf(ddy(arr(i, 1)), 4)
    
63.                 dyf(ddy(arr(i, 1)), 6) = dyf(ddy(arr(i, 1)), 6) + 1
    
64.             End If
    
65.         ElseIf arr(i, 5) = dyf(ddy(arr(i, 1)), 3) Then
    
66.             If dyf(ddy(arr(i, 1)), 5) > 0 Then
    
67.                 arr(i, 8) = 180 - dyf(ddy(arr(i, 1)), 5) + 1
    
68.                 dyf(ddy(arr(i, 1)), 5) = dyf(ddy(arr(i, 1)), 5) - 1
    
69.                 dyf(ddy(arr(i, 1)), 6) = dyf(ddy(arr(i, 1)), 6) + 1
    
70.             End If
    
71.         End If
    
72.    
    
73.     Next
    
74.    
    
75.     ReDim brr(32, 1)
    
76.     brr(0, 0) = "班级"
    
77.     brr(0, 1) = "VBA人数"
    
78.     For i = 1 To 32
    
79.         brr(i, 0) = "'" & Right("0" & i, 2)
    
80.     Next
    
81.    
    
82.     For i = 2 To UBound(arr)
    
83.         If arr(i, 7) > 0 And arr(i, 8) > 0 Then
    
84.             arr(i, 9) = 1
    
85.             brr(Val(arr(i, 2)), 1) = brr(Val(arr(i, 2)), 1) + 1
    
86.         Else
    
87.             arr(i, 9) = ""
    
88.         End If
    
89.     Next
    
90.    
    
91.     [g1].Resize(UBound(arr)) = Application.Index(arr, , 7) 'WorksheetFunction.Transpose(arr)
    
92.     [h1].Resize(UBound(arr)) = Application.Index(arr, , 8) 'WorksheetFunction.Transpose(arr)
    
93.     [i1].Resize(UBound(arr)) = Application.Index(arr, , 9) 'WorksheetFunction.Transpose(arr)
    
94.     Sheet3.[g1].Resize(33, 2) = brr
    
95.     Application.ScreenUpdating = True
    
96.     MsgBox Format(Timer - tm, "0.00")
    
97. End Sub
    
98. 
    

复制代码

因为里面使用了工作表函数=countif()来计算，所有工作表本身不能使用太多的函数，最好没有数组函数。否则计算时间会长到难以忍受。

香川群子

怀英慕者 发表于 2011-10-3 10:00
你可以做个调查，凡是来VBA模块的朋友大多是因为函数和公式已经阻碍了他们工作的人，换句话说，他们以前都 ...

建议你不看我的代码，自己编写一个VBA代码试试看。

hopeson2010

这贴还没结束啊？见到“无字天书”就犯晕！晕S过去了！

shaowu459

也提供一个，反正跟谁结果都不一样，但是比较接近楼主的结果，呵呵
=COUNT(MATCH(MOD(LARGE(IF(班=A2,总分*10^8+ROW(班)),ROW($1:$50)),10^7),(MMULT(N(IF(班=A2,语文,)<TRANSPOSE(IF(段

=OFFSET(数据!$A$1,MATCH(A2,班,),),语文,))),ROW($1:$1764)^0)>=59)*(MMULT(N(IF(班=A2,语文,)<TRANSPOSE(IF(段

=OFFSET(数据!$A$1,MATCH(A2,班,),),语文,))),ROW($1:$1764)^0)<=179)*ROW(班),))
大致解释一下：
首先：MOD(LARGE(IF(班=A2,总分*10^8+ROW(班)),ROW($1:$50)),10^7)，IF(班=A2,总分*10^8+ROW(班)，这部分将总分和行数

联系起来，外套large()取得前50的成绩和行号信息（同成绩取得行号小的数据，可能会和楼主有差异），再用mod（）取得前

50成绩的行号。

然后，MMULT(N(IF(班=A2,语文,)<TRANSPOSE(IF(段=OFFSET(数据!$A$1,MATCH(A2,班,),),语文,))),ROW($1:$1764)^0)，这部

分取得语文段内排序，然后>=59和<=170同时成立时取得行号，

最后，第一部得到的行号去第二部取得的行号里匹配，然后count计数

aaaaaa123459

香川群子 发表于 2011-10-3 15:21
这个题目用VBA也不是很简单的说。

下面的VBA代码，使用了词典嵌套。（数组是当然的了）因为里面使用了 ...

　　　女侠，我佩服死你了，你还在为解决这个问题尝试着各种办法！
　　　正因为如此，我的新帖才没有好意思点你的名，本来是想点你的名的，因为你的认真和真诚，只是感觉你为这个题目太累了，所以不忍心了。
　　　如果你得空了，到我的新帖上看看新的问题吧，还没有人象你这样能解决我的问题如此完美的呢！
　　　千万悠着点，别累着了。