­ã´£³¡ªL

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("¤u§@ªí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¦W³æ"): On Error GoTo 0
    
16. If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS¦W³æ"
    
17. With Sht
    
18. ¡@¡@.Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
    
19. End With
    
20. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

¦^´_ 4# t591nm


¤§«e¦³¦ìºô¤Í¬O³o¼Ë°µªº¡G
¢°¡D³v¦æµ{¦¡¥H¦Û¤vªº²z¸Ñ¥[¤Jµù¸Ñ¡AµM«á¦A¾ã­Ó¶K¥X¨Ó
¢±¡D¦³ºÃ°Ýªº³¡¥÷¦A´£¥X

³o¼Ë¤~¥i¥H¯u¥¿¾Ç¨ìµ{¦¡ªº¥Î·N¡A
§Ú¤]¤~¯àª¾¹D­n¸É¥R­þ¸Ìªº»¡©ú¡I

­ã´£³¡ªL

¦^´_ 6# t591nm


UBound(Arr)¡@
¡Ä¬°°}¦Cªº¡e¦C¼Æ¡f¡A¥i¼g¦¨ UBound(Arr , 1)¡FUBound(Arr, 2)¡@«h¬°¡eÄæ¼Æ¡f¡@

Jm = Jm + 1¡@
¡Ä¬°¤w¨ú±o²Å¦X "PASS" ¸ê®Æªº¡e²Ö­pµ§¼Æ¡f¡@

For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next ¡@
¡Ä¨Ì Arr ªº¡eÄæ¼Æ¡f°j°é±N¸ê®Æ©ñ¤J°}¦C¡A¦]±q²Ä¢°¢¸¦C¶}©l¡A¬G¶·¡Ï¢°¢·¡@

On Error Resume Next:¡@Set Sht = Sheets("PASS¦W³æ"):¡@On Error GoTo 0
¡ÄÀˬd¡ePASS¦W³æ¡f¤u§@ªí¬O§_¤w¦s¦b¡@
¡Ä­Y¤£¦s¦b¡ASet Sht = Sheets("PASS¦W³æ")¡@³o¦æ·|¦]¿ù»~¦Ó¤¤Â_
¡ÄOn Error Resume Next¡@´N¬O­n¡e²¤¹L¿ù»~¡f¨Ïµ{¦¡Ä~Äò¹B¦æ¡@
¡ÄOn Error GoTo 0¡@Åýµ{¦¡«ì´_ÀË°»¿ù¥\¯à¡@

If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS¦W³æ"
¡Ä¤u§@ªí¤£¦s¦b¡A·s¼W¤@­Ó·s¤u§@ªí¨Ã­«©R¦W¡@
¡@
With Sht
    .Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
End With
¡Ä¿ï¨ú¤u§@ªí¡D²M°£­ì¦³¸ê®Æ¡D¸m¤º°}¦C¤º®e¡@


¢Õ¢Ý¢â¢Ý¡@¢°¢¯¢°¡@
¡Ä·í±ø¥ó¦¨¥ß¡A«ü©wµ{¦¡¸õ¦Ü³o¤@¼Ð°O¦æ¡A¦Ó²¤¹L¨ä¤U¤èªºµ{¦¡¡@

­ã´£³¡ªL

¦^´_ 8# t591nm

³o¼Ë§ó½ÆÂø¨Ç¡A½Ð¦Û¦æ¬ã¨s¡G

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("¤u§@ªí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¦W³æ"): On Error GoTo 0
    
28. If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS¦W³æ"
    
29. With Sht
    
30. ¡@¡@¡@.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr
    
31. End With
    
32. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

¦^´_ 11# t591nm

¤W¶Ç½d¨ÒÀɦpªG¥i¥H¥¿±`°õ¦æ, ¨ä¥¦ÀÉ´N­n¥h¤ñ¹ï¨ä®t²§, ¤~ª¾¹D¿ù¦b­þ?
¸ê®Æ¥²¶·¬O¦³©T©w³W«hªº¡G
²Ä¢°¡ã¢°¢°¦C¡A¬°¡eªí­º¡f   
²Ä¢°¢±¦C¡A¬°¡e¼ÐÃD¦C¡f
²Ä¢°¢²¡ã¢°¢·¦C¡A¬°¡e¼Ðµù©Î³Æµù¡f§a¡]²q¡^
²Ä¢°¢¸¦C¤Î¥H¤U¡A¬°¡e¸ê®Æ©ú²Ó°Ï¡f

¦]«ü©w¡e¼ÐÃD¦C¡f²Å¦X¤å¦r¤~¨ú¥X¸ÓÄæ¡A
©Ò¥H¨ú¥X¸ê®Æ¥Ñ¢°¢¸¦C§ï¥Ñ¢°¢±¦C¶}©l¡A
­Y­n¨ú¢´¢¯µ§¡e©ú²Ó¡f¡A«h¥]§t¡e¼ÐÃD¡f¤§¶¡ªº¢¶¦C¡AJm = TX + 7¡@¤~°÷

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
¡ô³o¬q¥Î¨Ó±Æ°£¡e¼ÐÃD¦C¡f¤£²Å¦X¤å¦r®É¡A¨Ï¨ä¤å¦rÅܬ°ªÅ¦r²Å""¡A¥H¬°¤U¤è¨ú±o²Å¦X¡eÄæ¡f¸ê®Æªº¨Ì¾Ú¡@


½Ðª`·N¶×¤J¤å¦rÀɤζK¤J¸ê®Æªº°ÝÃD¡A
¦³¨S¦Ò¼{¹L¬°¦ó¸ê®Æ·|¦³¢µ¢´¢´¢²¢µ¦C¡A¦Ó¨ä¤¤¦³«Ü¦hªº¡e#N/A¡f¿ù»~­È¡H
copy1 = Sheets(1).Range("A1:Q8000")¡@³o¤~¢·¢¯¢¯¢¯¦C
Range("A1:Q65535") = copy1¡@«o¶K¦¨¢µ¢´¢´¢²¢µ¦C¡H¡H¡H¡H

­ã´£³¡ªL

Sub vbaAFilter()
Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, N&, uChk&, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub
Arr = Sheets("¤u§@ªí1").UsedRange.Value
ReDim Brr(1 To UBound(Arr, 2))
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
¡@
For j = 1 To UBound(Arr)
¡@¡@If Arr(j, 1) = "Crystal" Then¡@'¥H¡eCrystal¡f§PÂ_¬O§_¬°¡e¼ÐÃD¦C¡f¡@
¡@¡@¡@For k = 1 To UBound(Arr, 2)
¡@¡@¡@¡@¡@Brr(k) = Arr(j, k)¡@'¼ÐÃD¤å¦r¯Ç¤J°}¦C¡A¤£²Å¦XªÌ¶ñ¤JªÅ¦r²Å¡@
¡@¡@¡@¡@¡@If k > 2 And InStr(TT, "_" & Arr(j, k) & "_") = 0 Then Brr(k) = ""
¡@¡@¡@Next k
¡@¡@¡@uChk = 1: ¡@N = j - 1¡@'¼ÐÃD¦C¤W¤èªº¡e¦C¼Æ¡f¡@
¡@¡@End If
¡@
¡@¡@If Arr(j, 1) = 1 Then uChk = 2: N = j - 1: Jm = 0¡@
¡@¡@'¡Ä­Y¢ÏÄ欰¢°¡A«h§PÂ_¬°¡e©ú²Ó¡fªº¶}©l¡A¢Ü¬°¤W¤è¦C¼Æ¡AJmÂk¹s¡@
¡@¡@If uChk = 0 Then GoTo 101
¡@¡@If uChk = 2 And Arr(j, 2) <> "PASS" Then GoTo 101
¡@¡@Jm = Jm + 1: Km = 0
¡@¡@For k = 1 To UBound(Arr, 2)
¡@¡@¡@¡@If Brr(k) <> "" Then Km = Km + 1: Arr(Jm + N, Km) = Arr(j, k)
¡@¡@Next
¡@
¡@¡@If uChk = 2 And Jm = TX Then Exit For
101: Next j
If Jm = 0 Then Exit Sub
¡@
On Error Resume Next: Set Sht = Sheets("PASS¦W³æ"): On Error GoTo 0
If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS¦W³æ"
With Sht
¡@¡@.Select: .UsedRange.Clear: .[A1].Resize(Jm + N, Km) = Arr
End With
End Sub

'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
uChk =1 ªí¥Ü°j°é¨ì¡e¼ÐÃD¦C¡f
uChk =2 ªí¥Ü°j°é¨ì¡e©ú²Ó¡fªº¶}ÀY

¸ê®Æ©³¤Uªº¡e¿ù»~­È¡f°È¥²¥ý²M°£¡ã¡ã¡@

­ã´£³¡ªL

¦^´_ 14# t591nm


¬O¥i¥H±N¡e¼ÐÃD¦C¡f¤Î¡e©ú²Ó¶}ÀY¡f±j¨î©T©w¦C¸¹¡A
­Y¦³¤£¦P¡A¥i¤â°Ê½Õ¾ã¡A¥u­n¦h«O¯d´X­ÓªÅ¥Õ¦C·í½w½Ä§Y¥i¡ã¡ã¿ìªk¬O·Q¥X¨Óªº¡ã¡ã