[發問] 如何設定當在表單1輸入A值帶出表單2所有A值的數據

013160

請問Excel可以弄成跟Access一樣
在表單1輸入A值帶出表單2所有A值的數據嗎!?
檔案：
http://sync.hamicloud.net/_oops/k_k013160/tn1

yen956

回復 1# 013160
這是2003版, 你的是2007版, 應有更簡單版
但應仍可用, 試試看:

1. 'Sheet1
   
2. Option Explicit
   
3. '考慮到【編號】相當長(長達12位數),故用下拉式選單輸入【編號】
   
4. Private Sub ComboBox1_Change()
   
5.     Dim sh1, sh2 As Object
   
6.     Dim i, endRow, cnt As Integer
   
7.     Set sh1 = Sheets("Sheet1")
   
8.     Set sh2 = Sheets("Sheet2")
   
9.     If ComboBox1 = "" Then Exit Sub
   
10.    
    
11.     '清除原有資料
    
12.     sh1.[B2].Resize(2000, 2) = ""
    
13.    
    
14.     '取得 編號 最後一列的列號
    
15.     endRow = sh2.[D2000].End(xlUp).Row
    
16.     cnt = 1
    
17.     For i = 2 To endRow
    
18.         If sh2.Cells(i, 4) = --ComboBox1 Then
    
19.             cnt = cnt + 1
    
20.             sh1.Cells(cnt, 2) = sh2.Cells(i, 1)  '複製 頁數
    
21.             sh1.Cells(cnt, 3) = sh2.Cells(i, 6)  '複製 餘數
    
22.         End If
    
23.     Next
    
24. End Sub
    
25. '
    
26. 'Sheet2
    
27. Option Explicit
    
28. '如果 Sheet2 的【編號】有增減時,可點選 Sheet2,
    
29. '用以觸動本程序, 進行資料重整
    
30. Private Sub Worksheet_Activate()
    
31.     Dim i, endRow As Integer
    
32.    
    
33.     '2007版似可 將【篩選】與【排序】一併處理
    
34.     '可惜我的是 2003版, 只能分開處理
    
35.     '用【進階篩選】將【編號】篩選到 欄I, 並去除【重覆編號】
    
36.     Range("D1:D2000").AdvancedFilter Action:=xlFilterCopy, _
    
37.               CriteriaRange:=Range("D1:D2000"), _
    
38.               CopyToRange:=Range("I1"), Unique:=True
    
39.    
    
40.     endRow = [I2000].End(xlUp).Row
    
41.     '將篩選結果, 複製到 欄J
    
42.     [J1].Resize(2000, 1) = ""
    
43.     For i = 1 To endRow
    
44.         Cells(i, 10) = Cells(i, 9)
    
45.         Cells(i, 9) = ""
    
46.     Next
    
47.    
    
48.     '將 欄J 按升冪排序, 並將格式設為 "0000000000000"
    
49.     Range("J1:J2000").Sort Key1:=Range("J1"), _
    
50.           Order1:=xlAscending, Header:=xlYes
    
51.     Range("J1:J2000").NumberFormatLocal = "0000000000000"
    
52.    
    
53.     '重新定義 名稱 "x" 的範圍, 供 Sheet1 的 ComboBox1 用
    
54.     endRow = [J2000].End(xlUp).Row
    
55.     ActiveWorkbook.Names("x").Delete
    
56.     ActiveWorkbook.Names.Add Name:="x", _
    
57.           RefersToR1C1:="=Sheet2!R2C10:R" & endRow & "C10"
    
58. End Sub

複製代碼

輸入編號.7z
http://www.mediafire.com/download/4bw6wen76mga98f/輸入編號.7z

013160

回復 2# yen956


    謝謝yen956的告知，問題已解決。

013160

回復 2# yen956
來不及編輯補上我的疑問
  '將篩選結果, 複製到 欄J     -----------------複製到欄J但我沒看到J欄有顯示出任何資料!?
    [J1].Resize(2000, 1) = ""-------2000是指2000筆資料嗎!?
    For i = 1 To endRow
        Cells(i, 10) = Cells(i, 9)
        Cells(i, 9) = ""
    Next