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

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

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


¦b¶×¤J¨ä¥LªºexcelÀÉ°õ¦æ«áµo²{
.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr   
¬õ¦â¦rÅ鳡¤À¥X²{¿ù»~
°õ¦æ¶¥¬q¿ù»~'1004'
½Ð°Ý¬O¤°»ò°ÝÃD©O

ÁÂÁÂ

TOP

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

TOP

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


­ì¨Ó¦p¦¹
·PÁª©¤jÀ°¦£
¥Ø«e´ú¸Õ«áµo²{µ´¤j¦h¼Æ³£¨S°ÝÃD
§Ú¦A¸Õ¸Õ

Ãö©ó65535ªº³¡¤À
¤w¸g­×§ï¬°¤@­Pªº¦C¼Æ
¦Ü©ó¬°¦ó³]¨º»ò¦h
¬O¦]¬°¨C¦¸¶q´úÁû¼Æ¤£¤@©w
¬G¤~³]©w¦h¤@ÂIªº¦C¼Æ

·PÁ¤j¤j

TOP

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

¤w¸gª¾¹D¬°¤°»ò¦³¨ÇÀÉ®×´ú¸Õ®É .[A1].Resize(Jm + 11, Km) = Arr ·|¥X²{¿ù»~
¦]¬°Àɮפ¤ªº®æ¦¡¤£¤@­P
¦p¦Pª©¥D©Ò´£¨ìªº¡G
²Ä¢°¡ã¢°¢°¦C¡A¬°¡eªí­º¡f   
²Ä¢°¢±¦C¡A¬°¡e¼ÐÃD¦C¡f
²Ä¢°¢²¡ã¢°¢·¦C¡A¬°¡e¼Ðµù©Î³Æµù¡f§a
²Ä¢°¢¸¦C¤Î¥H¤U¡A¬°¡e¸ê®Æ©ú²Ó°Ï¡f
¦ý§Ú¨C­ÓÀɮתº¼ÐÃD¦C¤£¨£±o¦b²Ä12¦C
¦]¬°²Ä13~18¦C¤¤¦³®É«á·|¬°¤F³Æµù¨ä¥L¸ê°T
©Ò¥H²Ä¤@µ§´ú¸Õ¼Æ­È¤£¨£±o·|¦b²Ä19¦C

¬G§Ú·Q§PÂ_²Å¦X¤å¦rªº³¡¤À­n±q²Ä¤@¦C¶}©l
¨Ì¾Ú¥Ø«e¤u§@ªíªº§@¥Î½d³òªºÄæ¨Ó¶i¦æ³v¤@ªº§PÂ_
¤£ª¾¹D§Ú³o¼ËªºÅÞ¿è¹ï¤£¹ï

TOP

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

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°£¡ã¡ã¡@

TOP

¦^´_ 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¨Óªº¡ã¡ã

TOP

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


¤Ó·PÁª©¥D¤F
­è¤]·Q¥HCrystal°µ¬°¼ÐÃD¦Cªº§PÂ_
¥u¬OÁÙ¨Srun¥X¨Ó

§Ú¬O³o¼Ë¼g
TT2 = "Crystal"
For j2 = 1 To UBound(Brr, 1)
If InStr(TT2, "_" & Brr(1, j) & "_") = 0 Then
¥u¬O¿ù¦bIf InStr(TT2, "_" & Brr(1, j) & "_") = 0 Then ³o¤@¦æ
§Ú¥ý¸Õ¸Õª©¤jªº¿ìªk

TOP

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

·PÁª©¥D
´ú¸Õ¦¨¥\
Åý§Ú¾Ç²ß¨ì«Ü¦h²Ó¸`
ÁÂÁÂ

TOP

¦^´_ 17# t591nm

ª©¥D¤£¦n·N«ä
§Ú¤S¦³­Ó²Â°ÝÃD¤F
Private Sub CommandButton1_Click()
fileToOpen = Dir(Application.GetOpenFilename("Excel File(*.xls),*.xls"))
a = Split(fileToOpen, "/")
b = a(UBound(a))
MsgBox Left(b, InStr(b, ".") - 1)
End Sub
¥H¤W¬O§Úrun¹L½T©w¥i¥H°õ¦æªºµ{¦¡½X

Private Sub CommandButton4_Click()
    Dim Arr3 As Variant

    Arr3 = Array("PASS¦W³æ", "DATA")
    Sheets(Arr3).Copy
    Arr3 = Application.GetSaveAsFilename(fileFilter:="*.xls, *.xls")
End Sub
¥H¤Wµ{¦¡½X¤¤§Ú´N¦³°ÝÃD¤F
§Ú·QÅýCommandButton1_Click()¤¤ªºb¥i¥H³QCommandButton4_Click()¨Ó¨Ï¥Î
¥Ñ©óÆ[©À¤£²M·¡©Ò¥H¤£ª¾¹D«ç»ò¤Þ¥Î
§Ú©Ò­nªº¬O¥t¦s·sÀÉ®ÉÀɦW¬°¸Óµ§©Ò¶×¤JªºÀɦW¥B¤£§t°ÆÀɦW
¥»¨Ó·Q»¡¦bCommandButton1_Click()¤¤¤w¸g¥i¥Hrun¥X¨Ó­nªºÀɦW¤F
«o¨S·Q¨ì«á´ÁµLªkª½±µ¤Þ¥Î...
¦Ó¥BÁÙ¦³¤@­Ó°ÝÃD...¥i¯à¬O¦]¬°¥t¦s·sÀɤ¤¦³¨â­Ó¤u§@ªí...©Ò¥H­n«ö¨â¦¸¦sÀɤ~¥i¥H
¥H¤W¤£ª¾¹D¦p¦ó±Æ¸Ñ
·PÁ¤j¤j

TOP

¤w¸Ñ¨M

Private Sub CommandButton4_Click()
   Dim nm As String, FileFolder As String
   nm = Sheets("DATA").Range("G1").Value
   Arr3 = Array("PASS¦W³æ", "DATA")
   Sheets(Arr3).Copy
   FileFolder = Application.GetSaveAsFilename(nm & "-", "(*.xls),*.xls")
   Sheets("DATA").Range("G1").Clear
   Sheets("PASS¦W³æ").Range("G1").Clear
   ActiveWorkbook.SaveAs FileFolder
End Sub

³o¼Ë´N¥i¥H¹F¨ì§Ú­nªº¥Øªº¤F

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD