c_c_lai

¦^´_ 1# ljuber
¸Õ¸Õ¬Ý¡G

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim loc As Long, cts As Long, txtFile As String, arr() As String, sp() As String
   
5.    
   
6.     Application.DisplayAlerts = False
   
7.     Application.ScreenUpdating = False
   
8.    
   
9.     txtFile = Application.GetOpenFilename("(*.txt), *.txt")
   
10.     If txtFile = "" Then Exit Sub
    
11.    
    
12.     sp = Split(txtFile, "\")
    
13.     With Workbooks("½m²ß.xlsm")
    
14.         cts = .Sheets("³]©w").Range("A1").End(xlDown).Row
    
15.         
    
16.         ReDim Preserve arr(cts - 1)       '  °ÊºA¦a³B²z arr °}¦C±a¤J¤§°}¦C­È¡C
    
17.         For loc = 2 To cts
    
18.            arr(loc - 1) = .Sheets("³]©w").Range("A" & loc).Text   '
    
19.         Next loc
    
20.         
    
21.         loc = .Sheets("¸ê®Æ").Range("A1").End(xlDown).Row
    
22.         '  Workbooks.OpenText Filename:=ThisWorkbook.Path & "\10412-ai201.txt", Origin:=950, Tab:=True, TrailingMinusNumbers:=True
    
23.         Workbooks.OpenText Filename:=txtFile, Origin:=950, Tab:=True, TrailingMinusNumbers:=True
    
24.       
    
25.         ActiveSheet.Range("A:G").AutoFilter Field:=5, _
    
26.             Criteria1:=arr, Operator:=xlFilterValues
    
27.             '  °ÊºA¦a³B²z Criteria1 ±a¤J¤§­È¡C
    
28.             '  Criteria1:=Array("11001", "11005", "11009"), Operator:=xlFilterValues
    
29.         Columns("A:G").Copy
    
30.         .Sheets("¸ê®Æ").Range("A" & loc + 1).PasteSpecial Paste:=xlPasteValues
    
31.         
    
32.         '  Workbooks("10412-ai201.txt").Close
    
33.         Workbooks(sp(UBound(sp))).Close
    
34.         '  .Sheets("¸ê®Æ").Range("A" & loc + 1).Select
    
35.     End With
    
36. End Sub

½Æ»s¥N½X