ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

vba ¨Ì¾Útextbox¤¤©Ò»Ý¤Jªº­È¿z¿ï¥X¬Û¹ïªºµ§¼Æ

vba ¨Ì¾Útextbox¤¤©Ò»Ý¤Jªº­È¿z¿ï¥X¬Û¹ïªºµ§¼Æ

¦pÃD
¬[ºc¤j¬ù¬O
1.¶×¤J©Ò»ÝÀÉ®×
2.¦btextbox¿é¤J¼Æ­È
3.¨Ì¾Útextboxªº¼Æ­È±N¶×¤JªºÀÉ®×±ø¥ó¦¡ªº¶i¦æ¿z¿ï
4.±Nµ²ªG½Æ»s¨ì·s«Ø¥ßªº¤u§@ªí¤¤

¥H¤W¥Ø«e¥d¦b3.
¹ê¦b¤£ª¾¹D¦p¦ó¨Ì¾Útextbox©Ò¿é¤Jªº¼Æ­È
Åý¦Û°Ê¿z¿ïªº³¡¥÷±N³Ì«e­±²Ä?µ§ªºPASS¦C¥X¨Ó
¥Ø«e¥d¦b³o¸Ì
ªþ¤WÀÉ®×
·PÁ¤j¤j test.rar (266.23 KB)

  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

TOP

·P®¦ª©¥D
©ú¦­¦Ü¤½¥q¸Õ¸Õ¬Ý
¦p¦³¤£À´ªº¦A¨Ó½Ð±Ð
¦A¦¸·P®¦

TOP

¦^´_ 2# ­ã´£³¡ªL


·P®¦ª©¥D¡A¤w¸g¦¨¥\
·Q½Ð±ÐÃö©óµ{¦¡½Xªº¤j²¤¸ÑÄÀ
ÁÂÁÂ

TOP

¦^´_ 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

TOP

¦^´_ 5# ­ã´£³¡ªL


­ì¨Ó¦p¦¹
ÁÂÁ´£¿ô
¥H¤U¬°¦Û¤v¹ïµ{¦¡½Xªº¨£¸Ñ
Dim j&, Jm&, k&, TX&, Arr, Sht As Worksheet '«Å§i©Ò»ÝªºÅܼƩó¤u§@ªí¤¤
    TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX¬OTextBox1ªº¤º®e,­YTextBox1ªº¤º®e=0ªº¸Ü´N¸õ¥Xµ{¦¡
    Arr = Sheets("¤u§@ªí1").UsedRange.Value '¶Ç¦^¸Ó¤u§@ªí¤¤¤w¨Ï¥Îªº½d³òµ¹Arr°}¦C
    For j = 19 To UBound(Arr) '°j°é¤¤j=19(À³¸Ó¬O§Ú²Ä¤@Áûªºdata¬O±q²Ä19¦C¶}©l)¨ì¶Ç¦^Arr¤¤©Ò«ü©wºû«×ªº³Ì°ª¥i¥Îµù¼Ð-------¤£À´
    If IsError(Arr(j, 2)) Then GoTo 101 '­Y°}¦C¤¤¦³²£¥Í¥ô¦ó¤@ºØ¿ù»~­È«h¸õ¨ì101,2:À³¸Ó¬O«ü²Ä2Äæ,µM«á
    If Arr(j, 2) <> "PASS" Then GoTo 101 '­Y°}¦C¤¤¥]§tPASSªº¸Ü´NÄ~Äò¤U­±,§_«h´N¸õ¨ì101
    Jm = Jm + 1 'À³¸Ó¬O¦Cªºªì©l値
    For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next '°j°é¤¤¤£ª¾¹DK¬O¤°»ò,¨ì¶Ç¦^¸Ó¤u§@ªí¤¤¤w¨Ï¥Îªº½d³òµ¹Arr»P²Ä2Äæ:Arr(¦Cªºªì©l値+18=19,1)=Arr(²Ä19¦C,1):next---------·¥«×¤£À´
    If Jm = TX Then Exit For '·íJm=TextBox1©Òªºkeyªº¤º®e®É,¸õ¥X°j°é
    101: Next j '101¨ìIf Arr(j, 2) <> "PASS" Then GoTo 101,¨Ï¨ä§PÂ_¬O§_²Å¦XPASS
    If Jm = 0 Then Exit Sub '·íJm=0«á¸õ¥Xµ{¦¡


¥H¤U³o¬q¥u¬ÝªºÀ´·s¼WPASS¦W³æªº¤u§@ªí
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 + 18, UBound(Arr, 2)) = Arr
End With   



¥H¤W...¥Ñ©ó§Ú¸ê½è¤£¨Î
¹ï©óµ{¦¡²z¸Ñ³¡¤À«Ü®z
©Ò¥H¸ÑÄÀªº«Ü¤£¦n
¦³³Ò±z¶O¤ß¤F

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-10-21 13:40 ½s¿è

¦^´_ 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¤èªºµ{¦¡¡@

TOP

¦^´_ 7# ­ã´£³¡ªL

­ì¨Ó¦p¦¹
·P®¦ª©¥D¦^ÂÐ

¥t¥~ÁÙ¦³¤@­Ó°ÝÃD
³]¤u§@ªí¬°´ú¶qDATA
³]§Ú©Ò­nªº´ú¶q°Ñ¼Æ³W®æ¬°FL¡BC0¡BC0/C1¡BRLD2¡BRR¡BTS¡BC1¡BFDLD¡BDLD2
§Ú­n³o¨Ç¤w¸g¿z¿ï¥X¨ÓªºPASS¸ê®Æ¤¤
¥u­n«O¯d©Ò·Q­nªº°Ñ¼Æ³W®æ
¨ä¥L¤£»Ý­nªº¬Ò§R°£

¥Ø«eªº·Qªk¬O
³]°}¦C(¤º§t¬°©Ò­nªº°Ñ¼Æ³W®æ)
¥Îfor»Pif¶i¦æ°}¦C»PÀx¦s®æ¤ñ¹ï
­Y¤£¦b³W®æ¤ºªº´N§R°£

¥i¬O«o¤£ª¾¹D«ç»ò¤U¤â¨Ó¼gµ{¦¡
¥i§_¥H¤j¤è¦Vªº»¡©ú¨ÓÅý¤p©f¸Õ¸Õ
¦A¦¸ÁÂÁÂ

TOP

¦^´_ 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

TOP

¦^´_ 9# ­ã´£³¡ªL


Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX¬°TextBox1¤º©Ò¿é¤Jªº値,­Y¬°0«h¸õ¥Xµ{¦¡
With Sheets("¤u§@ªí1").UsedRange '¶Ç¦^¤u§@ªí1¥¿¦b¨Ï¥Îªº½d³ò
¡@¡@Arr = .Value 'Arrªì©l値¬°1 to 65535,1 to 17-----À³¸Ó¬O½d³ò¤¤ªº¦C»PÄæ
¡@¡@Brr = .Rows(12) 'Brrªºªì©l値¬°1 to 1,1 to17------À³¸Ó¬ORange(A12:Q12),¦]¬°©Ò­n«O¯dªº¦r¦ê¬O±q¦C12¶}©l¨ì¦³¸ê®Æªº³Ì«á¤@Äæ
End With
¡@
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_" 'TTÀ³¸Ó¬O§Ú­n«O¯dªº¦r¦ê
For j = 3 To UBound(Brr, 2) '¨Ì Brr ªº¦C¼Æ¥Î°j°é±N¸ê®Æ©ñ¤J°}¦C,¦ÓjÀ³¸Ó¬O²Ä¤TÄæ
¡@¡@If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = "" 'InStrÀ³¸Ó¬O§PÂ_Brr(²Ä¤@¦C,²Ä¤TÄæ)¤ºªº¦r¦ê,­Y²Å¦X¸õ¨ì¤U¤@­Ófor°j°é,­Y¤£²Å¦X¦r¦ê«h¸õ¨ì¸õ¦^ifÄ~Äò´`Àô§PÂ_-------À³¸Ó¤£¬O³o¼Ë§a
Next
¡@
For j = 12 To UBound(Arr) '°j°é¥Ñj=12¦C¶}©l¨ìArr°}¦Cªº¦C¼Æ
¡@¡@If j > 18 Then '­Yj>18Äæ
¡@¡@¡@   If IsError(Arr(j, 2)) Then GoTo 101 '­YArr°}¦Cªº²Ä18¦C²Ä2Äæ¥X²{¿ù»~ªº¸Ü«h¸õ¨ì101,¦Ó²¤¹L¤U­±ªºµ{¦¡
¡@¡@¡@¡@If Arr(j, 2) <> "PASS" Then GoTo 101 '­YArr°}¦Cªº²Ä18¦C²Ä2Ä椣µ¥©óPASSªº¸Ü«h¸õ¨ì101,¦Ó²¤¹L¤U­±ªºµ{¦¡
¡@¡@End If
¡@¡@Jm = Jm + 1: Km = 0 'Jm?,Km?
¡@¡@For k = 1 To UBound(Arr, 2) 'k=1¨ìArr°}¦CªºÄæ¼Æ
¡@¡@¡@¡@If Brr(1, k) <> "" Then Km = Km + 1: Arr(Jm + 11, Km) = Arr(j, k) '­YBrr(1,k)¤£µ¥©ó0,«h±Nm=Km+1©ñ¤JArr(Jm+11,Km)¤¤,«hµ¥©óArr(j,k)-----¦¹®É²Ä¤@¦¸j=12,Jm=1,k=1,Km=1,Ä~Äò¶]for°j°é,¥i¬OÁÙ¬O¬Ý¤£À´¦UÅܼƪºÃö«Y
¡@¡@Next
¡@¡@If Jm = TX + 7 Then Exit For '·íJm=TextBox1¤º©Ò¿é¤Jªº値+7«h¸õ¥X¾ã­Ófor°j°é-----¬°¤°»ò­n+7?
101: Next j '101µ{¦¡°Ï¶ô·|Next j-------¤£À´
If Jm = 0 Then Exit Sub '­YJm=0«h¸õ¥X¾ã­Óµ{¦¡
¡@
On Error Resume Next: Set Sht = Sheets("PASS¦W³æ"): On Error GoTo 0 'ÀˬdPASS¦W³æªº¤u§@ªí¬O§_¤w¦s¦b,­Y¤£¦s¦b«h²¤¹L¦¹¶µ¿ù»~,Ä~Äò¨Ïµ{¦¡°õ¦æ¨Ã¨Ïµ{¦¡«ì´_ÀË´ú»P°»¿ù¥\¯à
If Sht Is Nothing Then Set Sht = Sheets.Add:  Sht.Name = "PASS¦W³æ" '¤u§@ªí¤£¦s¦b¡A«h·s¼W¤@­Ó¤u§@ªí¨Ã­«©R¦W¬°PASS¦W³æ
With Sht
¡@¡@¡@.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr '¿ï¨ú¤u§@ªí,²M°£­ì¦³¸ê®Æ,¨Ã¸m¤º°}¦C¤º®e-----¤°»ò¬O¸m¤º°}¦C¤º®e?
End With


¥H¤W¬°°Ñ¦Òª©¥D¥ý«eªº¸ÑÄÀ¥[¤W¦Û¤v¤p¤p±ÀºV
­Y¤£¹ï©Î¸ÑÄÀ¤£²M·¡ªº¦a¤è
Áٽм·ªÅÀ°§Ú¸Ñ´b
ÁÂÁ±z

TOP

        ÀR«ä¦Û¦b : ¦³Ä@©ñ¦b¤ß¸Ì¡A¨S¦³¨­Åé¤O¦æ¡A¥¿¦p¯Ñ¥Ð¤£¼½ºØ¡A¬Ò¬OªÅ¹L¦]½t¡C
ªð¦^¦Cªí ¤W¤@¥DÃD