GBKEE

¦^´_ 1# tsuan
µ{¦¡½X:   ½Æ»s¶K¤W¦b [¬d¸ß]¤u§@ªíªº¼Ò²Õ

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)  '[¬d¸ß]¤u§@ªíªº ( ­×§ïÀx¦s®æ ) IJµo¨Æ¥ó
   
3.     If Target.Address(0, 0) = "B1" Or Target.Address(0, 0) = "F1" Then
   
4.         Application.EnableEvents = False                            '°±¤î:IJµo¨Æ¥ó
   
5.         'EnableEvents ÄÝ©Ê ¦pªG«ü©wª«¥ó¯àIJµo¨Æ¥ó¡A«h¥»Äݩʬ° True¡CŪ/¼g Boolean¡C
   
6.         Range("A3").CurrentRegion.Offset(1) = ""                    '²M°£Â¦³¬d¸ß¸ê®Æ
   
7.         With Sheets("Ápµ¸¤H")
   
8.             .AutoFilterMode = False
   
9.             'AutoFilterMode ÄÝ©Ê ¦pªG¥Ø«e¦b¤u§@ªí¤WÅã¥Ü¦³ [¦Û°Ê¿z¿ï] ¤U©Ô½b¸¹¡A«h¦¹Äݩʬ° True¡C
   
10.             '¸ÓÄÝ©Ê»P FilterMode Äݩʤ¬¬Û¿W¥ß¡CŪ/¼g Boolean¡C
    
11.             .Range("A1").AutoFilter 1, "*" & [B1] & "*"
    
12.             '[¦Û°Ê¿z¿ï] ²Ä¤@Äæ ·Ç«h¦r¦ê:   "*" & [B1] & "*"
    
13.             
    
14.             .Range("A1").AutoFilter 2, "*" & [F1] & "*"
    
15.             '[¦Û°Ê¿z¿ï] ²Ä¤GÄæ ·Ç«h¦r¦ê:   "*" & [F1] & "*"
    
16.             
    
17.             .UsedRange.Offset(1).Copy [A4]                          '½Æ»s¸ê®Æ
    
18.             .AutoFilterMode = False
    
19.         End With
    
20.         Application.EnableEvents = True
    
21.     End If
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 2# die78325
¬d¸ß¥\¯à() :¥[¤W¤½¥q¬d¸ß
Name ¬OVBA¨Ï¥ÎªºÃöÁä¦r  ÅܼÆ,µ{§Ç¦WºÙ­nÁקK¨Ï¥Î

1. Option Explicit
   
2. Sub ¬d¸ß¥\¯à()
   
3.     Dim ¤H­û As Range, ¤½¥q As Range, I As Integer
   
4.     Application.ScreenUpdating = False  'Ãö³¬Åã¥Ü
   
5.     With Sheets("¬d¸ß")
   
6.         Set ¤½¥q = .Range("B1")
   
7.         Set ¤H­û = .Range("F1")
   
8.         .Range("A4:A" & .[a4].End(xlDown).Row).EntireRow = ""
   
9.     End With
   
10.     With Sheets("Ápµ¸¤H")
    
11.         For I = 2 To .[B65536].End(xlUp).Row
    
12.             If .Cells(I, 1) Like "*" & ¤½¥q & "*" And .Cells(I, 2) Like "*" & ¤H­û & "*" Then '¸U¥Î¦r¤¸¦¬´M
    
13.                 Sheets("Ápµ¸¤H").Range("A" & I & ":J" & I).Copy
    
14.                 With Sheets("¬d¸ß")
    
15.                     .Cells(.[a65536].End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues
    
16.                 End With
    
17.             End If
    
18.         Next I
    
19.     End With
    
20.     Sheets("¬d¸ß").Activate
    
21.     [F1].Select
    
22.     Application.ScreenUpdating = True  '¶}±ÒÅã¥Ü
    
23. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# yanto913

1. Option Explicit
   
2. Sub ¬d¸ß¥\¯à()
   
3.     Dim Ex_Name As String, Ex_¤½¥q
   
4.     'Name ¬OVBAªºÃöÁä¦r½ÐÁקK¨Ï¥Î
   
5.     'Ãö³¬Åã¥Ü
   
6.     Application.ScreenUpdating = False
   
7.     With Sheets("¬d¸ß")
   
8.         Ex_Name = .Range("F1")   '©m¦W
   
9.         Ex_¤½¥q = .Range("B1")   '¤½¥q
   
10.       '  .UsedRange.Offset(2).Clear  '²M°£Â¦³ªº¬d¸ß
    
11.     End With
    
12.     With Sheets("Ápµ¸¤H")
    
13.         G = .[B65536].End(xlUp).Row
    
14.             For I = 2 To G
    
15.                 '¸U¥Î¦r¤¸¦¬´M
    
16.               '  If .Cells(I, 2) Like "*" & Ex_Name & "*" Then '¥u¬d©m¦W
    
17.                 If .Cells(I, 1) Like "*" & Ex_¤½¥q & "*" And .Cells(I, 2) Like "*" & Ex_Name & "*" Then '¬d ©m¦W¤Î¤½¥q
    
18.                 'If .Cells(I, 1) Like "*" & Ex_¤½¥q & "*" Or .Cells(I, 2) Like "*" & Ex_Name & "*" Then '¥i¬d©m¦W Or ¤½¥q
    
19.                     .Range(.Cells(I, 1), .Cells(I, 10)).Copy
    
20.                     c = Sheets("¬d¸ß").[a65536].End(xlUp).Row
    
21.                     Sheets("¬d¸ß").Cells(c + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
22.                     :=False, Transpose:=False
    
23.                 End If
    
24.             Next I
    
25.     End With
    
26.     Application.ScreenUpdating = True  '¶}±ÒÅã¥Ü
    
27. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# yanto913

¤U¸ü (53.89 KB)

2012-12-30 12:49