GBKEE

¦^´_ 14# b7307024
Â\©ñ¸ê®Æ¤u§@ªí¼Ò²Õªºµ{¦¡½X

1. Option Explicit                    '¦b¼Ò²Õ¼h¦¸¤¤±j­¢¨C­Ó¦b¼Ò²ÕùتºÅܼƳ£¥²¶·©ú½Tªº«Å§i¡C
   
2. Option Base 1                      '¦b¼Ò²Õ¼h¦¸¤¤¥Î¨Ó«Å§i°}¦C¯Á¤Þªº¹w³]¤U­­->¬° 1
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.     If Target.Address = "$B$1" Then
   
5.          Ext_data Target
   
6.     End If
   
7. End Sub
   
8. Private Sub Ext_data(ByVal Target As Range)
   
9.     Dim mnth As Worksheet, all_month(), Rng As Range, AR(), R As Range, S As Integer
   
10.     S = 1
    
11.     Application.ScreenUpdating = False
    
12.     Set Rng = Target.Parent.Range("A5")
    
13.     Rng.CurrentRegion.Offset(1).Clear
    
14.     all_month = Array("Jan", "Feb", "Mar")
    
15.     For Each mnth In Sheets(all_month)
    
16.         With mnth
    
17.             .Range("A1").AutoFilter 4, "*" & Target & "*"            '¦Û°Ê¿z¿ï
    
18.             For Each R In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
    
19.                 If R.Row > 1 Then
    
20.                     ReDim Preserve AR(1 To S)
    
21.                     'AR(S) = R   '¾ã¦C
    
22.                     AR(S) = Array(R.Cells(1).Value, R.Cells(4).Value)  '¤é´Á,²Ó¸`
    
23.                     S = S + 1
    
24.                 End If
    
25.             Next
    
26.             .AutoFilterMode = False
    
27.         End With        
    
28.     Next
    
29.     Rng.Offset(1).Resize(S - 1, UBound(AR(1))) = Application.Transpose(Application.Transpose(AR))
    
30.     Application.ScreenUpdating = True
    
31. End Sub

½Æ»s¥N½X