請教要如何尋找並排序~

ms2001

表 一 .
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

試試看:

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

複製代碼