[µo°Ý] VBA ·j´Mªº°ÝÃD

sss1159

HI¡A¤j®a¦n

¦bºô¸ô¤Wª¦¤F¤@¬q®É¶¡¡A´ú¤F¦hºØªº°µªkÁÙ¬O¨S§ä¨ì²z·Qªº¤è¦¡
¦b¦¹¸ß°Ý¤@¤U¦U¦ì¤j¤j

¦³2­Ó¤u§@ªí
¤u§@ªí1 = ¦s©ñ¦UºØ¸ê®Æªº¦a¤è
¤u§@ªí2 = ·j´M°Ï

³oÃä»Ý­n2ºØ¤è¦¡:
1.
¦b¤u§@ªí2 ·j´M°Ï ¿é¤J­n·j´Mªº¸ê®Æ¡i¥Ò¡j
§Y¥iÅã¥Ü ¦³Ãö©ó¡i¥Ò¡jªº©Ò¦³¸ê®Æ

2.
¦b¤u§@ªí1 ÂI¿ï·j´M
·|¸õ¥X¼uµ¡ ¿é¤J¡i¥Ò¡j
´N·|¦b¤u§@ªí1 Åã¥Ü©Ò¦³Ãö©ó ¯Z¯Å¡i¥Ò¡jªº¸ê®Æ

¦bÂI¿ï «ö¶s¨ú®ø·j´M §Y¥i«ì´_¦¨­ì¨Óªº©Ò¦³¸ê®Æ


¦b³Â·Ð¦U¦ì¤j¤j±Ð¾É¡AÁÂÁÂ

v03586

½Ð°ÝVBA·j´M¤è¦¡¥u¯à¥Î¿z¿ïªº¶Ü?
¯à¤£¯à¹³½Í¥X¤@­Óµe­± ¤U­±Åã¥Ü§A·j´MªºÃöÁä¦r©O?

GBKEE

¦^´_ 27# sss1159

1. '³Ì·Rªº¹B°Ê=>FÄæ
   
2.     .AutoFilter Field:=6, Criteria1:="=ÂŲy", Operator:=xlOr, Criteria2:="=±Æ²y"

½Æ»s¥N½X

¤£ª¾VBAµ{¦¡½X¦p¦ó½s¼g,¥i¿ý»s¥¨¶°½m²ß

¤U¸ü (73.47 KB)

2015-11-13 06:23

­ã´£³¡ªL

¦^´_ 27# sss1159


For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
¡@¡@If Instr("ÂŲy±Æ²y", .Cells(j, 6)) Then
¡@¡@¡@¡@Jm = Jm + 1
¡@¡@¡@¡@.Cells(j, 1).Resize(1, 6).Copy xH(Jm)
¡@¡@End If
Next j

sss1159

HI ¡Aª±¤@ª±¤W­zªº¤½¦¡¤S¦^¨Óµo°Ý¤F:P

1.
Sub ¿z¿ï()
    Dim X$
    X = Application.InputBox("½Ð¿é¤J¿z¿ïÃöÁä¦r")
    If X = "" Or X = "False" Then Exit Sub
    With Sheets("¤u§@ªí1").[A3]  '
        .Parent.AutoFilterMode = False
        
        .AutoFilter Field:=1, Criteria1:="*" & X & "*"
        If .End(xlDown).Row = Rows.Count Then MsgBox "§ä¤£¨ì¸ê®Æ!!": Exit Sub
        .CurrentRegion.Sort Key1:=.Range("C3"), Order1:=xlAscending, Header:=xlYes
    End With
End Sub

­ì¥»·j´Mªº¬O²Ä¤@Äæ ¯Z¯Å¡A­Y§Ú·Q·j´Mªº¬O²Ä¥|Äæ ©Ê§O
§Ú¸Ó¦p¦ó­×§ï©O? §Ú¼Æ¦r³£§ï¹L¤F><"


2.
Sub ·j´M()
Dim X$, R&, xSht As Worksheet, M, j&, Jm&, xH As Range
R = ActiveSheet.UsedRange.Rows.Count
If R > 5 Then Rows("6:" & R).Delete
X = Application.InputBox("½Ð¿é¤J·j´MÃöÁä¦r")
If X = "" Or X = "False" Then Exit Sub
For Each xSht In Sheets(Array("¤u§@ªí1", "¤u§@ªí3", "¤u§@ªí4"))
    Set xH = Range(Array("A6", "I6", "P6")(M))
    M = M + 1: Jm = 0
    With xSht
          For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
              If InStr(.Cells(j, 1) & .Cells(j, 2), X) Then
                  Jm = Jm + 1
                  .Cells(j, 1).Resize(1, 6).Copy xH(Jm)
              End If
          Next j
          If Jm = 0 Then MsgBox "¡e" & .Name & "¡f§ä¤£¨ì¡e" & X & "¡f¬ÛÃö¸ê®Æ!!":
         
    End With
Next
End Sub

¤u§@ªí2ªº·j´M ·Q¼W¥[¥t¤@ºØ¤è¦¡
¤£¨Ï¥ÎINPUTBOX ¡Aª½±µ§ï¦¨ Äx²y©Î±Æ²y ¨âºØµ²ªG³£·j´M¥X¨Ó
¸Ó¦p¦ó­×§ï©O


¦A³Â·Ð«ü±Ð¡A±Ð¾É¤F¡A·PÁ¦A·PÁÂ

sss1159

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

«D±`·PÁ¨â¦ìªO¥Dªº¦^ÂÐ><

Sub ±Æ§Ç()
Dim R&, LRR, Lm%, Lx%
R = [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
¡@
LRR = Split("ÂŲy_±Æ²y_´Î²y_¨¬²y_®à²y", "_") ¡@'±Æ§Ç²M³æ
With Application
¡@¡@¡@Lm = .GetCustomListNum(LRR) ¡@'Àˬd²M³æªº¦ì¸m
¡@¡@¡@If Lm = 0 Then .AddCustomList ListArray:=LRR ¡@'²M³æ¤£¦s¦b,«Ø¥ß
¡@¡@¡@Lx = .GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹
End With
¡@
With [¤u§@ªí1!A3:F3].Resize(R - 2)
¡@¡@¡@.Select
¡@¡@¡@.Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
If Lm = 0 Then Application.DeleteCustomList ListNum:=Lx ¡@'²M³æ­Y¬O¥»¦¸«Ø¥ß,§R°£²M³æ
End Sub

¨Ï¥Î¤F³o­Ó¤èªk½T¹ê¥i¥H¶¶§Qªº±Æ§Ç¡A
¦ý¥u­n«ö¤U¦sÀÉ¡A¾ã­ÓEXCEL ´N·|·í±¼¤F....
¬Ý¨Ó¦ü¥G¥u¯à¥ÎGBª©¤j ªº¤â°Ê¸ê®Æ±Æ§Ç¤F:Q

­ã´£³¡ªL

¦^´_ 21# sss1159

³o¬O¸û§¹¾ãªº°µªk¡A²M³æ¤£¦s¦b¡A¦Û°Ê«Ø¥ß¡AÀH«á¦A§R±¼¡ã¡ã
¡@
Sub ±Æ§Ç()
Dim R&, LRR, Lm%, Lx%
R = [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
¡@
LRR = Split("ÂŲy_±Æ²y_´Î²y_¨¬²y_®à²y", "_") ¡@'±Æ§Ç²M³æ
With Application
¡@¡@¡@Lm = .GetCustomListNum(LRR) ¡@'Àˬd²M³æªº¦ì¸m
¡@¡@¡@If Lm = 0 Then .AddCustomList ListArray:=LRR ¡@'²M³æ¤£¦s¦b,«Ø¥ß
¡@¡@¡@Lx = .GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹
End With
¡@
With [¤u§@ªí1!A3:F3].Resize(R - 2)
¡@¡@¡@.Select
¡@¡@¡@.Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
If Lm = 0 Then Application.DeleteCustomList ListNum:=Lx ¡@'²M³æ­Y¬O¥»¦¸«Ø¥ß,§R°£²M³æ
End Sub

­ã´£³¡ªL

¦^´_ 21# sss1159


LRR = Array("®à²y", "¦Ð²y", "®à²y", "Äx²y") ¡@'±Æ§Ç²M³æ¡@
Application.AddCustomList ListArray:=LRR ¡@'«Ø¥ß²M³æ¡@
Lx = Application.GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹¡@

With [¤u§@ªí1!A3:F3].Resize(R - 2)
     .Select
     .Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
           OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
¡@
°Ñ¦Ò§Y¥i¡A³o²M³æ±Æ§Ç¨Ï¥Îvba¼u©Ê¨Ã¤£¦n¡ã¡ã

GBKEE

¦^´_ 20# sss1159
¥Î§AªºªþÀÉ 2003 ¨S³o°ÝÃD .
¦^´_ 21# sss1159
2003 ¥i¥Î

¤U¸ü (62.29 KB)

2015-11-11 06:49

­ã´£³¡ªL

¦^´_ 21# sss1159


OFFICE 2000 ¨S³o¥\¯à, À°¤£¤F~~