请教一个表格转换的问题

cbtaja

jiminyanyan 发表于 2014-5-16 20:43
我自己也写了一个，和2楼老师的差不多。。。。

既然能写出VBA，可优化的空间就不会太多了。还是贴上代码，供参考。

1. Sub test()
   
2. Dim arr, r&, p&, i&, j&, xm$, n&, dic As Object
   
3. arr = Sheet1.[a1].CurrentRegion
   
4. r = UBound(arr)
   
5. Set dic = CreateObject("Scripting.Dictionary")
   
6. p = 1
   
7. For i = 2 To r
   
8.     If arr(i, 4) > 41 Then
   
9.         xm = arr(i, 1) & arr(i, 2) & arr(i, 3)
   
10.         If dic.exists(xm) Then
    
11.             n = dic(xm)
    
12.             If arr(i, 4) > arr(n, 4) Then arr(n, 4) = arr(i, 4)
    
13.         Else
    
14.             p = p + 1
    
15.             dic(xm) = p
    
16.             For j = 1 To 4
    
17.                 arr(p, j) = arr(i, j)
    
18.             Next
    
19.         End If
    
20.     End If
    
21. Next
    
22. Sheet1.[h:k].Clear
    
23. Sheet1.[h1].Resize(p, 4) = arr
    
24. End Sub
    

复制代码

LMY123

sql = "select first(学校名称),first(姓名),first(性别),first(分数) from (select * from [人员信息$a1:d]  where 分数>41 order by 分数 desc) group by 姓名"