排序!!

Cyssuc

A             B                C            D
數學        20                英文        30,60,78,74
英文        30                化學        65,32,89
數學        40                自然        75,96,85
英文        60                數學        20,40,95,34
自然        75                       
化學        65       
數學        95                       
英文        78                       
自然        96                       
化學        32                       
數學        34                       
英文        74                       
自然        85                       
化學        89                       

如何在D1輸入公式讓答案產生
PS AB資料會不斷更新

hcm19522

http://blog.xuite.net/hcm19522/twblog關鍵字  2645
類似題

hcm19522

http://blog.xuite.net/hcm19522/twblog/458262431

greetingsfromtw

回復 3# hcm19522

感謝hcm19522前輩提供解答,十分值得研究.

小弟本想另開新主題提問,因想提的問題為VBA,應不屬一般區的範圍內.
但因問題是源於此主題,故用回文方式,
若有不妥還請不吝告知,小弟一定改進,十分感謝.

小弟看到此主題後有試著用板上前輩的程式碼擅自修改,試圖寫出類似結果.
附上檔案及程式碼,希望能夠有所幫助.有不當處請不吝告知,小弟一定改進.
因功力太差,修改出來的程式碼非常冗長,而且有一個問題,就是要先將原始資料用excel的內建功能排序過後,結果才可正常顯示....

若有前輩願意抽空指點更簡潔的寫法,小弟感激不盡.

1. '此程式碼修改自麻辣家族討論區excel高手淮提部林前輩所寫,非我自創.
   
2. '討論區網址:http://forum.twbts.com/index.php
   
3. 
   
4. Sub test1()
   
5. Dim arr, arr1, arr2, arr3, arr4, brr(1 To 4), k, Ar
   
6. arr = Range("a2:b" & Cells(Rows.Count, 1).End(xlUp).Row)
   
7. 
   
8. 
   
9. '巨集錄製excel的從小到大排序功能(排序B欄)
   
10.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    
11.     ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2"), _
    
12.         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
13.     With ActiveWorkbook.Worksheets("Sheet1").Sort
    
14.         .SetRange Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    
15.         .Header = xlNo
    
16.         .MatchCase = False
    
17.         .Orientation = xlTopToBottom
    
18.         .SortMethod = xlPinYin
    
19.         .Apply
    
20.     End With
    
21. '錄製結束
    
22. 
    
23. 
    
24. '計算每個科目出現的次數
    
25. Set myD = CreateObject("scripting.dictionary")
    
26. For k = 1 To UBound(arr)
    
27. T = arr(k, 1)
    
28. myD(T) = myD(T) + 1
    
29. Next k
    
30. 
    
31. 
    
32. ReDim arr1(1 To myD("英文"))
    
33. ReDim arr2(1 To myD("國文"))
    
34. ReDim arr3(1 To myD("數學"))
    
35. ReDim arr4(1 To myD("自然"))
    
36. 
    
37. 
    
38. For i = 1 To UBound(arr)
    
39. 
    
40. If arr(i, 1) = "英文" Then N = 1
    
41. If arr(i, 1) = "國文" Then N = 2
    
42. If arr(i, 1) = "數學" Then N = 3
    
43. If arr(i, 1) = "自然" Then N = 4
    
44. 
    
45. brr(N) = brr(N) + 1
    
46. 
    
47. If N = 1 Then arr1(brr(1)) = arr(i, 2)
    
48. If N = 2 Then arr2(brr(2)) = arr(i, 2)
    
49. If N = 3 Then arr3(brr(3)) = arr(i, 2)
    
50. If N = 4 Then arr4(brr(4)) = arr(i, 2)
    
51. 
    
52. 101:
    
53. Next i
    
54. 
    
55. 
    
56. [e2] = Join(arr1, "、")
    
57. [e3] = Join(arr2, "、")
    
58. [e4] = Join(arr3, "、")
    
59. [e5] = Join(arr4, "、")
    
60. 
    
61. End Sub

複製代碼

20161025-陣列-排序科目分數.zip (12.78 KB)

下載次數: 3

2016-10-26 23:30

小弟不知此種發問方式以及用板上前輩程式碼修改去回答板友問題的方式是否恰當,
若有不妥當處請不吝指正與告知,小弟一定改進,十分感謝.

准提部林

下載 (24.22 KB)

2016-10-27 10:35

Ｃ１：=B1&LOOKUP("z",IF({1,0},"",","&VLOOKUP(A1,A2:C$9999,3,)))
Ｅ１：=VLOOKUP(D1,A:C,3,)

Xl0000197-1.rar (4.33 KB)

下載次數: 5

2016-10-27 10:37

　
　

greetingsfromtw

回復 5# 准提部林

等了一陣,
可能Cyssuc版友有點事未及回應,請允許小弟擅自回應一下,雖然不是我發的主題....
因個人理解,有前輩願意提供解答,可以的話能夠回應使用情形並表示感謝會是比較好的.
當然以上僅個人理解.言論有不當處請告知,小弟一定改進.

非常感謝淮提部林前輩提供解答,雖然不是原提問者,也是表達一下感謝.板友提的問題,其實有時候也會是自己想問的問題呢.

Cyssuc

感謝大家精闢的解答　
小弟感恩不盡
倘若回覆太晚
深感抱歉
另有一疑問
以下數列
６０，４０，８０，３０，９０
如何下函數
３０，４０，６０，８０，９０

hcm19522

=IFERROR(IF(COLUMN(A1)=1,"",",")&SMALL(IFERROR(--TRIM(MID(SUBSTITUTE($B2,",",REPT(" ",99)),ROW($1:$5)*99-98,99)),FALSE),COLUMN(A1))&E2,"")
往右拉五格 第一格為結果
http://blog.xuite.net/hcm19522/twblog/463182914