- 帖子
- 45
- 主題
- 10
- 精華
- 0
- 積分
- 59
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2014-2-6
- 最後登錄
- 2019-6-22
|
回復 3# hcm19522
感謝hcm19522前輩提供解答,十分值得研究.
小弟本想另開新主題提問,因想提的問題為VBA,應不屬一般區的範圍內.
但因問題是源於此主題,故用回文方式,
若有不妥還請不吝告知,小弟一定改進,十分感謝.
小弟看到此主題後有試著用板上前輩的程式碼擅自修改,試圖寫出類似結果.
附上檔案及程式碼,希望能夠有所幫助.有不當處請不吝告知,小弟一定改進.
因功力太差,修改出來的程式碼非常冗長,而且有一個問題,就是要先將原始資料用excel的內建功能排序過後,結果才可正常顯示....
若有前輩願意抽空指點更簡潔的寫法,小弟感激不盡.- '此程式碼修改自麻辣家族討論區excel高手淮提部林前輩所寫,非我自創.
- '討論區網址:http://forum.twbts.com/index.php
- Sub test1()
- Dim arr, arr1, arr2, arr3, arr4, brr(1 To 4), k, Ar
- arr = Range("a2:b" & Cells(Rows.Count, 1).End(xlUp).Row)
- '巨集錄製excel的從小到大排序功能(排序B欄)
- ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
- ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2"), _
- SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
- With ActiveWorkbook.Worksheets("Sheet1").Sort
- .SetRange Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
- .Header = xlNo
- .MatchCase = False
- .Orientation = xlTopToBottom
- .SortMethod = xlPinYin
- .Apply
- End With
- '錄製結束
- '計算每個科目出現的次數
- Set myD = CreateObject("scripting.dictionary")
- For k = 1 To UBound(arr)
- T = arr(k, 1)
- myD(T) = myD(T) + 1
- Next k
- ReDim arr1(1 To myD("英文"))
- ReDim arr2(1 To myD("國文"))
- ReDim arr3(1 To myD("數學"))
- ReDim arr4(1 To myD("自然"))
- For i = 1 To UBound(arr)
- If arr(i, 1) = "英文" Then N = 1
- If arr(i, 1) = "國文" Then N = 2
- If arr(i, 1) = "數學" Then N = 3
- If arr(i, 1) = "自然" Then N = 4
- brr(N) = brr(N) + 1
- If N = 1 Then arr1(brr(1)) = arr(i, 2)
- If N = 2 Then arr2(brr(2)) = arr(i, 2)
- If N = 3 Then arr3(brr(3)) = arr(i, 2)
- If N = 4 Then arr4(brr(4)) = arr(i, 2)
- 101:
- Next i
- [e2] = Join(arr1, "、")
- [e3] = Join(arr2, "、")
- [e4] = Join(arr3, "、")
- [e5] = Join(arr4, "、")
- End Sub
 20161025-陣列-排序科目分數.zip (12.78 KB)
小弟不知此種發問方式以及用板上前輩程式碼修改去回答板友問題的方式是否恰當,
若有不妥當處請不吝指正與告知,小弟一定改進,十分感謝. |
|
發表於 2016-10-26 23:34
| 