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

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

2^#

發表於 2015-10-17 10:59 | 只看該作者

Sub vbaAFilter()
Dim j&, Jm&, k&, TX&, Arr, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub
　
Arr = Sheets("工作表1").UsedRange.Value
For j = 19 To UBound(Arr)
　　If IsError(Arr(j, 2)) Then GoTo 101
　　If Arr(j, 2) <> "PASS" Then GoTo 101
　　Jm = Jm + 1
　　For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next
　　If Jm = TX Then Exit For
101: Next j
If Jm = 0 Then Exit Sub
　
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
End Sub

複製代碼

帖子: 51
主題: 9
精華: 0
積分: 73
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 20
註冊時間: 2015-7-28
最後登錄: 2015-12-17

3^#

發表於 2015-10-19 00:43 | 只看該作者

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

帖子: 51
主題: 9
精華: 0
積分: 73
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 20
註冊時間: 2015-7-28
最後登錄: 2015-12-17

4^#

發表於 2015-10-21 08:50 | 只看該作者

回復 2# 准提部林

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

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

5^#

發表於 2015-10-21 10:20 | 只看該作者

回復 4# t591nm

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

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

帖子: 51
主題: 9
精華: 0
積分: 73
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 20
註冊時間: 2015-7-28
最後登錄: 2015-12-17

6^#

發表於 2015-10-21 12:00 | 只看該作者

回復 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

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

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

7^#

發表於 2015-10-21 13:38 | 只看該作者

本帖最後由准提部林於 2015-10-21 13:40 編輯

回復 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
＿選取工作表．清除原有資料．置內陣列內容　

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

帖子: 51
主題: 9
精華: 0
積分: 73
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 20
註冊時間: 2015-7-28
最後登錄: 2015-12-17

8^#

發表於 2015-10-21 13:54 | 只看該作者

回復 7# 准提部林

原來如此
感恩版主回覆

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

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

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

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-25

9^#

發表於 2015-10-21 17:48 | 只看該作者

回復 8# t591nm

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

Sub vbaAFilter()
Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub
With Sheets("工作表1").UsedRange
　　Arr = .Value
　　Brr = .Rows(12)
End With
　
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
For j = 3 To UBound(Brr, 2)
　　If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = ""
Next
　
For j = 12 To UBound(Arr)
　　If j > 18 Then
　　　　If IsError(Arr(j, 2)) Then GoTo 101
　　　　If Arr(j, 2) <> "PASS" Then GoTo 101
　　End If
　　Jm = Jm + 1: Km = 0
　　For k = 1 To UBound(Arr, 2)
　　　　If Brr(1, k) <> "" Then Km = Km + 1: Arr(Jm + 11, Km) = Arr(j, k)
　　Next
　　If Jm = TX + 7 Then Exit For
101: Next j
If Jm = 0 Then Exit Sub
　
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 + 11, Km) = Arr
End With
End Sub

複製代碼

帖子: 51
主題: 9
精華: 0
積分: 73
點名: 0
作業系統: XP
軟體版本: Office 2003
閱讀權限: 20
註冊時間: 2015-7-28
最後登錄: 2015-12-17

10^#

發表於 2015-10-22 10:03 | 只看該作者

回復 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

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