[µo°Ý] ½Ð°Ý¦p¦ó§ó§ïVBªº³sµ²Àɮ׸ô®|

v60i

³o­ÓVBA¥\¯à¬O±N¦h­ÓTXT¤º®e¥þ³¡·|¶°¨ì¦P¤@­ÓEXCEL¤¤
¦ý¬O³oµ{¦¡¥²¶·¸òTXT¦b¦P¤@­Ó¥Ø¿ý
§Ú¸ÕµÛ­×§ï¦¨§âµ{¦¡©ñ¦bC:\«ü©w¶×¶°D:\¤¤ªºTXT
¥i¬O³£¨S¦¨¥\
½Ð°Ý­n«ç»ò­×§ï¤~OK??
ÁÂÁÂ


Sub ¶×¤J¤å¦rÀÉ()
Dim xFile, uFile, uHead As Range, Jm&, Km&, X, xT, xL
Range("A:A").Clear '²M°£Â¶פJ¸ê®Æ
'-----------------------------------------------------
Application.ScreenUpdating = False
Do
    If xChk = 0 Then
       xFile = Dir(ThisWorkbook.Path & "\*.txt")
       If xFile = "" Then MsgBox "¡°§ä¤£¨ì TXT ÀɮסI¡@", 0 + 16: Exit Sub
       xChk = 1
    Else
       xFile = Dir
       If xFile = "" Then Exit Do
    End If
    '----------------------------------------------
    uFile = ThisWorkbook.Path & "\" & xFile
    Set uHead = Range("A65536").End(xlUp)
    If uHead <> "" Then Set uHead = uHead(3, 1)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=uHead)
         .AdjustColumnWidth = False
         .TextFileColumnDataTypes = Array(1)
         .Refresh BackgroundQuery:=False
         .Delete
    End With
    uHead.Interior.ColorIndex = 6
    '¨Cµ§²Ä¤@®æ¥[¡e¶À¦â¡f©³
NEXT_LINE:
Loop
'-------------------------------------------------------
Application.ScreenUpdating = True
MsgBox "¡ã¡ã¶×¤J§¹¦¨¡ã¡ã¡@"
End Sub


¶×¤J¤å¦rÀÉ.zip (8.72 KB)

¤U¸ü¦¸¼Æ: 7

2011-12-27 06:34

v60i

¦^´_ 4# GBKEE


    ÁÂÁ¤j¤jªº­×¥¿

GBKEE

¦^´_ 3# v60i

1. With Application.FileDialog(msoFileDialogFolderPicker)
   
2. If .Show = 0 Then Exit Sub   '§ï³o¸Ì
   
3. fd = .SelectedItems(1)
   
4. End With

½Æ»s¥N½X

v60i

¦^´_ 2# Hsieh


    ¤j¤j ¦pªG§ÚÂI¥X¤F¿ï¾Ü¸ê®Æ§¨µe­±«á ¦pªG«ö¨ú®ø ·|¥X²{

¤U¸ü (12.71 KB)

2012-1-3 06:31

ÂI¿ï°»¿ù
fd = .SelectedItems(1)
·|¤Ï¶À­C

Hsieh

¦^´_ 1# v60i
¥Î¸ê®Æ§¨¹ï¸Ü¤è¶ôµ²ªG¨ú¥NThisWorkbook.Path

1. Sub ¶×¤J¤å¦rÀÉ()
   
2. Dim xFile, uFile, uHead As Range, Jm&, Km&, X, xT, xL
   
3. Range("A:A").Clear '²M°£Â¶פJ¸ê®Æ
   
4. '-----------------------------------------------------
   
5. With Application.FileDialog(msoFileDialogFolderPicker)
   
6. .Show
   
7. fd = .SelectedItems(1)
   
8. End With
   
9. 
   
10. Application.ScreenUpdating = False
    
11. Do
    
12.     If xChk = 0 Then
    
13.        xFile = Dir(fd & "\*.txt")
    
14.        If xFile = "" Then MsgBox "¡°§ä¤£¨ì TXT ÀɮסI¡@", 0 + 16: Exit Sub
    
15.        xChk = 1
    
16.     Else
    
17.        xFile = Dir
    
18.        If xFile = "" Then Exit Do
    
19.     End If
    
20.     '----------------------------------------------
    
21.     uFile = fd & "\" & xFile
    
22.     Set uHead = Range("A65536").End(xlUp)
    
23.     If uHead <> "" Then Set uHead = uHead(3, 1)
    
24.     With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=uHead)
    
25.          .AdjustColumnWidth = False
    
26.          .TextFileColumnDataTypes = Array(1)
    
27.          .Refresh BackgroundQuery:=False
    
28.          .Delete
    
29.     End With
    
30.     uHead.Interior.ColorIndex = 6
    
31.     '¨Cµ§²Ä¤@®æ¥[¡e¶À¦â¡f©³
    
32. NEXT_LINE:
    
33. Loop
    
34. '-------------------------------------------------------
    
35. Application.ScreenUpdating = True
    
36. MsgBox "¡ã¡ã¶×¤J§¹¦¨¡ã¡ã¡@"
    
37. End Sub

½Æ»s¥N½X