Board logo

標題: 請教要如何尋找並排序~ [打印本頁]
作者: ms2001    時間: 2014-3-22 17:49     標題: 請教要如何尋找並排序~

表 一 .
1 英文 25
1 國文 85
2 英文 80
2 國文 53
2 歷史 88
3 國文 33
3 地理 55
4 英文 66
4 國文 22
4 地理 55

希望能做出當我在表二的a1輸人編號後a2可以自動列出下面的低到高的排序，如

當a1輪入 "2" 時.

國文 53
英文 80
歷史 88

輸入"3"時..

國文 33
地理 55

----------
有高手可以幫幫忙嗎~
作者: yen956    時間: 2014-3-23 05:37

本帖最後由 yen956 於 2014-3-23 05:40 編輯

試試看:
  1. 'Sheet1 的VBA
  2. '資料整理
  3. Private Sub CommandButton1_Click()
  4.     Dim sh1, sh2 As Worksheet, rngA As Range
  5.     Dim endRow As Integer
  6.     Set sh1 = Sheets(1): Set sh2 = Sheets(2)
  7.    
  8.     endRow = sh1.[A1].End(xlDown).Row
  9.     sh2.[B1].Resize(endRow, 2) = ""
  10.    
  11.     '將 sh1.欄A 按升冪排序
  12.     sh1.[A1].Resize(endRow, 3).Sort _
  13.               Key1:=sh1.[A1], Order1:=xlAscending, _
  14.               Key2:=sh1.[C1], Order2:=xlAscending, _
  15.               Header:=xlYes
  16.    
  17.     '重新定義名稱 "x" 的範圍(sh1.欄A)
  18.     ActiveWorkbook.Names("x").Delete
  19.     ActiveWorkbook.Names.Add Name:="x", RefersToR1C1:="=Sheet1!R1C1:R" & endRow & "17C1"   
  20. End Sub
  21.    
  22. 'Sheet2 的VBA
  23. '欲在sh2.欄A 資料變更時觸發事件, 可用 Intersect 方法完成：
  24. Private Sub Worksheet_Change(ByVal Target As Range)
  25.     Dim sh1, sh2 As Worksheet, rngA As Range
  26.     Dim endRow, cnt As Integer
  27.     Set sh1 = Sheets(1): Set sh2 = Sheets(2)
  28.    
  29.     '將公式 MATCH 輸入 sh2.[F1]
  30.     '將 sh2.欄A 所輸入的 編號, 用公式 MATCH 獲取 對應到 sh1.欄A 的起始列號
  31.     sh2.[F1] = "=MATCH(E1, x, 0)"
  32.    
  33.     endRow = sh1.[A1].End(xlDown).Row
  34.    
  35.     '限定 資料變更時觸發事件 的有效範圍在 rngA 內
  36.     Set rngA = sh2.[A1].Resize(endRow, 1)
  37.    
  38.     If Not Intersect(Target, rngA) Is Nothing Then
  39.    
  40.         '將剛剛變更的 Target, 存入 sh2.[E1], 供 sh2.[F1] 的公式 MATCH 比對用
  41.         sh2.[E1] = Target
  42.         
  43.         '若 sh2.[F1] 是數值, 表示剛剛輸入了 有效數字
  44.         If Application.IsNumber(sh2.[F1]) Then
  45.             cnt = 0
  46.             Do
  47.                 Target.Offset(cnt, 1) = sh1.Cells(cnt + sh2.[F1], 2)
  48.                 Target.Offset(cnt, 2) = sh1.Cells(cnt + sh2.[F1], 3)
  49.                 cnt = cnt + 1
  50.             Loop Until sh1.Cells(cnt + sh2.[F1], 1) > sh1.Cells(sh2.[F1], 1) Or sh1.Cells(cnt + sh2.[F1], 1) = ""
  51.         End If
  52.     End If
  53. End Sub
複製代碼




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