Board logo

標題: 排序!! [打印本頁]
作者: Cyssuc    時間: 2016-10-23 23:41     標題: 排序!!

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    時間: 2016-10-25 10:36

http://blog.xuite.net/hcm19522/twblog關鍵字  2645
類似題
作者: hcm19522    時間: 2016-10-25 11:10

http://blog.xuite.net/hcm19522/twblog/458262431
作者: greetingsfromtw    時間: 2016-10-26 23:34

回復 3# hcm19522

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

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

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

若有前輩願意抽空指點更簡潔的寫法,小弟感激不盡.
  1. '此程式碼修改自麻辣家族討論區excel高手淮提部林前輩所寫,非我自創.
  2. '討論區網址:http://forum.twbts.com/index.php

  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)


  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. '錄製結束


  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


  32. ReDim arr1(1 To myD("英文"))
  33. ReDim arr2(1 To myD("國文"))
  34. ReDim arr3(1 To myD("數學"))
  35. ReDim arr4(1 To myD("自然"))


  38. For i = 1 To UBound(arr)

  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

  45. brr(N) = brr(N) + 1

  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)

  52. 101:
  53. Next i


  56. [e2] = Join(arr1, "、")
  57. [e3] = Join(arr2, "、")
  58. [e4] = Join(arr3, "、")
  59. [e5] = Join(arr4, "、")

  61. End Sub
複製代碼
[attach]25655[/attach]


小弟不知此種發問方式以及用板上前輩程式碼修改去回答板友問題的方式是否恰當,
若有不妥當處請不吝指正與告知,小弟一定改進,十分感謝.
作者: 准提部林    時間: 2016-10-27 10:35

本帖最後由 准提部林 於 2016-10-27 10:37 編輯

[attach]25660[/attach]


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

[attach]25661[/attach]
　
　
作者: greetingsfromtw    時間: 2016-10-30 00:15

回復 5# 准提部林

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

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

感謝大家精闢的解答　
小弟感恩不盡
倘若回覆太晚
深感抱歉
另有一疑問
以下數列
６０，４０，８０，３０，９０
如何下函數
３０，４０，６０，８０，９０
作者: hcm19522    時間: 2016-11-6 10:33

本帖最後由 hcm19522 於 2016-11-6 10:38 編輯

=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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)