luhpro

¦^´_ 1# alexsas38
¥u­n¦b .Cells.ClearContents ¤U¤è¥[¤W :
.Columns(2).NumberFormat = "@" <- ¸Ñ¨M 0 ®ø¥¢ªº°ÝÃD(±NÀx¦s®æ®æ¦¡³]¬° "¤å¦r")

µM«á¦bµ{¦¡¶}ÀY¥[¤W :
Dim lRow As Long, lI As Long

±µµÛ¦b .Cells.QueryTable.Delete ¤U¤è¥[¤W :
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
For lI = 1 To lRow
If Right(.Cells(lI, 1), 1) = "(" Then .Cells(lI, 2) = .Cells(lI, 1) & " " & .Cells(lI, 2) & " " & .Cells(lI, 3): .Cells(lI, 1) = "": .Cells(lI, 3) = ""
If .Cells(lI, 3) <> "" Then .Cells(lI, 2) = .Cells(lI, 2) & " " & .Cells(lI, 3) & " " & .Cells(lI, 4): .Cells(lI, 3) = "": .Cells(lI, 4) = ""
Next lI <- ¬JµMµ{¦¡·|©î¶}­ì¥ýªº¤å¦r ¨º»ò¦A¨Ì·Ó¨ä³W«h§â¸Ó¦X¨Öªº¦X¨Ö°_¨Ó´NOK¤F)
§Y¥i.

1. Sub importtxt()
   
2.     Dim path, folder, fname
   
3.     Dim lRow As Long, lI As Long
   
4.    
   
5.     With Workbooks.Add '¼ÐÃD¦C
   
6. 
   
7.         .Sheets(1).Range("A1:H1") = Array("Àç·~¤H²Î¤@½s¸¹", "­t³d¤H©m¦W", "Àç·~¤H¦WºÙ", "Àç·~¡]µ|Äy¡^µn°O¦a§}", "¸ê¥»ÃB(¤¸)", "²Õ´ºØÃþ", "³]¥ß¤é´Á", "µn°OÀç·~¶µ¥Ø")
   
8. 
   
9.         '·s¼W¼È¦s¸ê®Æªí
   
10. 
    
11.         With .Sheets.Add(after:=.Sheets(.Sheets.Count))
    
12. 
    
13.             'ÂsÄý¿ï¾Ü¸ê®Æ§¨
    
14. 
    
15.             With Application.FileDialog(msoFileDialogFolderPicker)
    
16. 
    
17.                 .AllowMultiSelect = False
    
18. 
    
19.                 If .Show = -1 Then path = .SelectedItems(1) & "\"
    
20. 
    
21.             End With
    
22. 
    
23.             '¹ï©Ò¦³¸Ó¸ê®Æ§¨¤Uªºtxt³B²z
    
24. 
    
25.             folder = Dir(path & "*.txt")
    
26. 
    
27.             Do While folder <> ""
    
28. 
    
29.                 .Cells.ClearContents
    
30.                 .Columns(2).NumberFormat = "@"
    
31.                
    
32.                 '¶×¤J¥~³¡¸ê®Æ
    
33. 
    
34.                 With .QueryTables.Add(Connection:="TEXT;" & path & folder, Destination:=.Range("A1"))
    
35. 
    
36.                     .Name = "¸ê®Æ"
    
37.                     .RefreshPeriod = 0
    
38. 
    
39.                     .TextFileSpaceDelimiter = True  'ªÅ¥ÕÁ䬰¤À³Î¦r¤¸
    
40. 
    
41.                     .Refresh BackgroundQuery:=False
    
42. 
    
43.                 End With
    
44. 
    
45.                 '§R°£¸ê®Æ³s½u
    
46. 
    
47.                 .Cells.QueryTable.Delete
    
48.                
    
49.                 lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    
50.                 For lI = 1 To lRow
    
51.                   If Right(.Cells(lI, 1), 1) = "(" Then .Cells(lI, 2) = .Cells(lI, 1) & " " & .Cells(lI, 2) & " " & .Cells(lI, 3): .Cells(lI, 1) = "": .Cells(lI, 3) = ""
    
52.                   If .Cells(lI, 3) <> "" Then .Cells(lI, 2) = .Cells(lI, 2) & " " & .Cells(lI, 3) & " " & .Cells(lI, 4): .Cells(lI, 3) = "": .Cells(lI, 4) = ""
    
53.                 Next lI
    
54. 
    
55.                 '·s¼W¸ê®Æ¨ì²Ä¤@­Ó¤u§@ªí
    
56. 
    
57.                 .Parent.Sheets(1).Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 8).Value = Application.Transpose(.Range("B1:B8").Value)
    
58. 
    
59.                 folder = Dir
    
60. 
    
61.             Loop
    
62. 
    
63.             '§R°£¼È¦s¸ê®Æªí,¤£Åã¥Üĵ§iµøµ¡
    
64. 
    
65.             Application.DisplayAlerts = False
    
66. 
    
67.             .Delete
    
68. 
    
69.             Application.DisplayAlerts = True
    
70. 
    
71.         End With
    
72. 
    
73.         .Sheets(1).Activate '¨Ï¶}±Ò¸ÓÀɮɪ½±µ¨ì²Ä¤@­Ó¤u§@ªí
    
74. 
    
75.         '¦sÀÉ
    
76. 
    
77.         fname = Application.GetSaveAsFilename(InitialFileName:=path & "final.xls", FileFilter:="Excel Files (*.xls),*.xls", Title:="Àx¦sÀÉ®×")
    
78. 
    
79.         '°£«D«ö¨ú®ø, §_«h¦sÀÉ
    
80. 
    
81.         If TypeName(fname) = "String" Then .SaveAs Filename:=fname, FileFormat:=xlExcel8
    
82. 
    
83.     End With
    
84. 
    
85. End Sub

½Æ»s¥N½X