vba 依據textbox中所需入的值篩選出相對的筆數

t591nm

如題
架構大約是
1.匯入所需檔案
2.在textbox輸入數值
3.依據textbox的數值將匯入的檔案條件式的進行篩選
4.將結果複製到新建立的工作表中

以上目前卡在3.
實在不知道如何依據textbox所輸入的數值
讓自動篩選的部份將最前面第?筆的PASS列出來
目前卡在這裡
附上檔案
感謝大大 test.rar (266.23 KB)

下載次數: 13

2015-10-16 15:20

准提部林

1. Sub vbaAFilter()
   
2. Dim j&, Jm&, k&, TX&, Arr, Sht As Worksheet
   
3. TX = TextBox1.Text: If TX = 0 Then Exit Sub
   
4. 　
   
5. Arr = Sheets("工作表1").UsedRange.Value
   
6. For j = 19 To UBound(Arr)
   
7. 　　If IsError(Arr(j, 2)) Then GoTo 101
   
8. 　　If Arr(j, 2) <> "PASS" Then GoTo 101
   
9. 　　Jm = Jm + 1
   
10. 　　For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next
    
11. 　　If Jm = TX Then Exit For
    
12. 101: Next j
    
13. If Jm = 0 Then Exit Sub
    
14. 　
    
15. On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
    
16. If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS名單"
    
17. With Sht
    
18. 　　.Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
    
19. End With
    
20. End Sub

複製代碼

t591nm

感恩版主
明早至公司試試看
如有不懂的再來請教
再次感恩

t591nm

回復 2# 准提部林


感恩版主，已經成功
想請教關於程式碼的大略解釋
謝謝

准提部林

回復 4# t591nm


之前有位網友是這樣做的：
１．逐行程式以自己的理解加入註解，然後再整個貼出來
２．有疑問的部份再提出

這樣才可以真正學到程式的用意，
我也才能知道要補充哪裡的說明！

t591nm

回復 5# 准提部林


原來如此
謝謝提醒
以下為自己對程式碼的見解
Dim j&, Jm&, k&, TX&, Arr, Sht As Worksheet '宣告所需的變數於工作表中
    TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX是TextBox1的內容,若TextBox1的內容=0的話就跳出程式
    Arr = Sheets("工作表1").UsedRange.Value '傳回該工作表中已使用的範圍給Arr陣列
    For j = 19 To UBound(Arr) '迴圈中j=19(應該是我第一顆的data是從第19列開始)到傳回Arr中所指定維度的最高可用註標-------不懂
    If IsError(Arr(j, 2)) Then GoTo 101 '若陣列中有產生任何一種錯誤值則跳到101,2:應該是指第2欄,然後
    If Arr(j, 2) <> "PASS" Then GoTo 101 '若陣列中包含PASS的話就繼續下面,否則就跳到101
    Jm = Jm + 1 '應該是列的初始値
    For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next '迴圈中不知道K是什麼,到傳回該工作表中已使用的範圍給Arr與第2欄:Arr(列的初始値+18=19,1)=Arr(第19列,1):next---------極度不懂
    If Jm = TX Then Exit For '當Jm=TextBox1所的key的內容時,跳出迴圈
    101: Next j '101到If Arr(j, 2) <> "PASS" Then GoTo 101,使其判斷是否符合PASS
    If Jm = 0 Then Exit Sub '當Jm=0後跳出程式


以下這段只看的懂新增PASS名單的工作表
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS名單"
With Sht
    .Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
End With   



以上...由於我資質不佳
對於程式理解部分很弱
所以解釋的很不好
有勞您費心了

准提部林

回復 6# t591nm


UBound(Arr)　
＿為陣列的〔列數〕，可寫成 UBound(Arr , 1)；UBound(Arr, 2)　則為〔欄數〕　

Jm = Jm + 1　
＿為已取得符合 "PASS" 資料的〔累計筆數〕　

For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next 　
＿依 Arr 的〔欄數〕迴圈將資料放入陣列，因從第１９列開始，故須＋１８　

On Error Resume Next:　Set Sht = Sheets("PASS名單"):　On Error GoTo 0
＿檢查〔PASS名單〕工作表是否已存在　
＿若不存在，Set Sht = Sheets("PASS名單")　這行會因錯誤而中斷
＿On Error Resume Next　就是要〔略過錯誤〕使程式繼續運行　
＿On Error GoTo 0　讓程式恢復檢偵錯功能　

If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS名單"
＿工作表不存在，新增一個新工作表並重命名　
　
With Sht
    .Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
End With
＿選取工作表．清除原有資料．置內陣列內容　


ＧＯＴＯ　１０１　
＿當條件成立，指定程式跳至這一標記行，而略過其下方的程式　

t591nm

回復 7# 准提部林

原來如此
感恩版主回覆

另外還有一個問題
設工作表為測量DATA
設我所要的測量參數規格為FL、C0、C0/C1、RLD2、RR、TS、C1、FDLD、DLD2
我要這些已經篩選出來的PASS資料中
只要保留所想要的參數規格
其他不需要的皆刪除

目前的想法是
設陣列(內含為所要的參數規格)
用for與if進行陣列與儲存格比對
若不在規格內的就刪除

可是卻不知道怎麼下手來寫程式
可否以大方向的說明來讓小妹試試
再次謝謝

准提部林

回復 8# t591nm

這樣更複雜些，請自行研究：

1. Sub vbaAFilter()
   
2. Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, TT$, Sht As Worksheet
   
3. TX = TextBox1.Text: If TX = 0 Then Exit Sub
   
4. With Sheets("工作表1").UsedRange
   
5. 　　Arr = .Value
   
6. 　　Brr = .Rows(12)
   
7. End With
   
8. 　
   
9. TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
   
10. For j = 3 To UBound(Brr, 2)
    
11. 　　If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = ""
    
12. Next
    
13. 　
    
14. For j = 12 To UBound(Arr)
    
15. 　　If j > 18 Then
    
16. 　　　　If IsError(Arr(j, 2)) Then GoTo 101
    
17. 　　　　If Arr(j, 2) <> "PASS" Then GoTo 101
    
18. 　　End If
    
19. 　　Jm = Jm + 1: Km = 0
    
20. 　　For k = 1 To UBound(Arr, 2)
    
21. 　　　　If Brr(1, k) <> "" Then Km = Km + 1: Arr(Jm + 11, Km) = Arr(j, k)
    
22. 　　Next
    
23. 　　If Jm = TX + 7 Then Exit For
    
24. 101: Next j
    
25. If Jm = 0 Then Exit Sub
    
26. 　
    
27. On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
    
28. If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS名單"
    
29. With Sht
    
30. 　　　.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr
    
31. End With
    
32. End Sub

複製代碼

t591nm

回復 9# 准提部林


Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX為TextBox1內所輸入的値,若為0則跳出程式
With Sheets("工作表1").UsedRange '傳回工作表1正在使用的範圍
　　Arr = .Value 'Arr初始値為1 to 65535,1 to 17-----應該是範圍中的列與欄
　　Brr = .Rows(12) 'Brr的初始値為1 to 1,1 to17------應該是Range(A12:Q12),因為所要保留的字串是從列12開始到有資料的最後一欄
End With
　
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_" 'TT應該是我要保留的字串
For j = 3 To UBound(Brr, 2) '依 Brr 的列數用迴圈將資料放入陣列,而j應該是第三欄
　　If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = "" 'InStr應該是判斷Brr(第一列,第三欄)內的字串,若符合跳到下一個for迴圈,若不符合字串則跳到跳回if繼續循環判斷-------應該不是這樣吧
Next
　
For j = 12 To UBound(Arr) '迴圈由j=12列開始到Arr陣列的列數
　　If j > 18 Then '若j>18欄
　　　   If IsError(Arr(j, 2)) Then GoTo 101 '若Arr陣列的第18列第2欄出現錯誤的話則跳到101,而略過下面的程式
　　　　If Arr(j, 2) <> "PASS" Then GoTo 101 '若Arr陣列的第18列第2欄不等於PASS的話則跳到101,而略過下面的程式
　　End If
　　Jm = Jm + 1: Km = 0 'Jm?,Km?
　　For k = 1 To UBound(Arr, 2) 'k=1到Arr陣列的欄數
　　　　If Brr(1, k) <> "" Then Km = Km + 1: Arr(Jm + 11, Km) = Arr(j, k) '若Brr(1,k)不等於0,則將m=Km+1放入Arr(Jm+11,Km)中,則等於Arr(j,k)-----此時第一次j=12,Jm=1,k=1,Km=1,繼續跑for迴圈,可是還是看不懂各變數的關係
　　Next
　　If Jm = TX + 7 Then Exit For '當Jm=TextBox1內所輸入的値+7則跳出整個for迴圈-----為什麼要+7?
101: Next j '101程式區塊會Next j-------不懂
If Jm = 0 Then Exit Sub '若Jm=0則跳出整個程式
　
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0 '檢查PASS名單的工作表是否已存在,若不存在則略過此項錯誤,繼續使程式執行並使程式恢復檢測與偵錯功能
If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS名單" '工作表不存在，則新增一個工作表並重命名為PASS名單
With Sht
　　　.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr '選取工作表,清除原有資料,並置內陣列內容-----什麼是置內陣列內容?
End With


以上為參考版主先前的解釋加上自己小小推敲
若不對或解釋不清楚的地方
還請撥空幫我解惑
謝謝您