Excel 2007 VBAŪTXTÀɨÃÂà¸m part 2

alexsas38

­Y¸ê®Æ§ïµ{¦p¤U:
1.txt
Àç·~¤H²Î¤@½s¸¹ 11111111
­t³d¤H©m¦W ³\xx
Àç·~¤H¦WºÙ xx¥ø·~ªÀ
Àç·~¡]µ|Äy¡^µn°O¦a§} xx¥«xx°Ïxx¨½xx¸ôxx«Ñxx¸¹x¼Ó
¸ê¥»ÃB(¤¸) 100000
²Õ´ºØÃþ ¿W¸ê( 6 )
³]¥ß¤é´Á 1020723
µn°OÀç·~¶µ¥Ø ´¶³q­ÜÀx¸gÀç( 530100 )
²î¤W³fª«¸Ë¨ø( 525912 )
¥]¸Ë©ÓÅóªA°È( 820914 )

2.txt
Àç·~¤H²Î¤@½s¸¹ 01111111
­t³d¤H©m¦W ¶Àxx
Àç·~¤H¦WºÙ xx¥ø·~ªÀ
Àç·~¡]µ|Äy¡^µn°O¦a§} xx¥«xx°Ïxx¨½xx¸ôxx«Ñxx¡Ðx¸¹x¼Ó
¸ê¥»ÃB(¤¸) 60000
²Õ´ºØÃþ ¿W¸ê( 6 )
³]¥ß¤é´Á 0780522
µn°OÀç·~¶µ¥Ø ¨ä¥Lª÷ÄݼҨã»s³y( 251299 )
.
.
.
®Ú¾Ústillfish00¤j¤jªºµ{¦¡­×§ï¦p¤U:
Sub importtxt()
    Dim path, folder, fname
    With Workbooks.Add '¼ÐÃD¦C

        .Sheets(1).Range("A1:H1") = Array("Àç·~¤H²Î¤@½s¸¹", "­t³d¤H©m¦W", "Àç·~¤H¦WºÙ", "Àç·~¡]µ|Äy¡^µn°O¦a§}", "¸ê¥»ÃB(¤¸)", "²Õ´ºØÃþ", "³]¥ß¤é´Á", "µn°OÀç·~¶µ¥Ø")

        '·s¼W¼È¦s¸ê®Æªí

        With .Sheets.Add(after:=.Sheets(.Sheets.Count))

            'ÂsÄý¿ï¾Ü¸ê®Æ§¨

            With Application.FileDialog(msoFileDialogFolderPicker)

                .AllowMultiSelect = False

                If .Show = -1 Then path = .SelectedItems(1) & "\"

            End With

            '¹ï©Ò¦³¸Ó¸ê®Æ§¨¤Uªºtxt³B²z

            folder = Dir(path & "*.txt")

            Do While folder <> ""

                .Cells.ClearContents

                '¶×¤J¥~³¡¸ê®Æ

                With .QueryTables.Add(Connection:="TEXT;" & path & folder, Destination:=.Range("A1"))

                    .Name = "¸ê®Æ"
                    .RefreshPeriod = 0

                    .TextFileSpaceDelimiter = True  'ªÅ¥ÕÁ䬰¤À³Î¦r¤¸

                    .Refresh BackgroundQuery:=False

                End With

                '§R°£¸ê®Æ³s½u

                .Cells.QueryTable.Delete

                '·s¼W¸ê®Æ¨ì²Ä¤@­Ó¤u§@ªí

                .Parent.Sheets(1).Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 8).Value = Application.Transpose(.Range("B1:B8").Value)

                folder = Dir

            Loop

            '§R°£¼È¦s¸ê®Æªí,¤£Åã¥Üĵ§iµøµ¡

            Application.DisplayAlerts = False

            .Delete

            Application.DisplayAlerts = True

        End With

        .Sheets(1).Activate '¨Ï¶}±Ò¸ÓÀɮɪ½±µ¨ì²Ä¤@­Ó¤u§@ªí

        '¦sÀÉ

        fname = Application.GetSaveAsFilename(InitialFileName:=path & "final.xls", FileFilter:="Excel Files (*.xls),*.xls", Title:="Àx¦sÀÉ®×")

        '°£«D«ö¨ú®ø, §_«h¦sÀÉ

        If TypeName(fname) = "String" Then .SaveAs Filename:=fname, FileFormat:=xlExcel8

    End With

End Sub


¦ý¬O·|¦³3­Ó°ÝÃD,
1. ­Y"Àç·~¤H²Î¤@½s¸¹"²Ä¤@½X¬O0, Ū¤J«á²Ä¤@½X0·|¤£¨£.
2. "²Õ´ºØÃþ"ªº¸ê®Æ,¨Ò¦p¬O: ¿W¸ê( 6 ), ¦]¬°(©M6¤¤¶¡¬OªÅ¥Õ, ¸ê®Æ·|¥uŪ¨ì"¿W¸ê("´N°±¤î.
3. "µn°OÀç·~¶µ¥Ø",¤]¦³¹³²Ä¤G¶µ¤@¼Ëªº°ÝÃD,(«á¬OªÅ¥Õ,«á­±ªº¸ê®Æ´N·|¤£¨£.

·Q½Ð°Ý¦p¦ó¸Ñ¨M³o¤T­Ó°ÝÃD? ¤Ó·PÁ±zªºÀ°¦£¤F~

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

Hsieh

¦^´_ 1# alexsas38

1. Sub ex()
   
2. Dim Mystr$
   
3. Cells.Clear '²M°£¤º®e
   
4. '¼ÐÃD
   
5. ay = Array("Àç·~¤H²Î¤@½s¸¹", "­t³d¤H©m¦W", "Àç·~¤H¦WºÙ", "Àç·~¡]µ|Äy¡^µn°O¦a§}", "¸ê¥»ÃB(¤¸)", "²Õ´ºØÃþ", "³]¥ß¤é´Á", "µn°OÀç·~¶µ¥Ø")
   
6. k = 1
   
7. Cells(k, 1).Resize(, 8) = ay '¼g¤J¼ÐÃD¦C
   
8. fd = ThisWorkbook.Path & "\" '¤å¦rÀɥؿý
   
9. Set fso = CreateObject("Scripting.FileSystemObject")
   
10. fs = Dir(fd & "*.txt") 'ÀɦW
    
11. Do Until fs = ""
    
12. Set f = fso.OpenTextFile(fd & fs)
    
13. Mystr = f.readall 'Ū¨ú¤º®e
    
14. For Each a In ay '¨ú®ø¼ÐÃD¤å¦r
    
15. Mystr = Replace(Mystr, a, "")
    
16. Next
    
17. ar = Split(Mystr, Chr(10)) '¥H¤À¦æ²Å¸¹¤Á³Î¤º®e
    
18. k = k + 1
    
19. Cells(k, 1).Resize(, UBound(ar) + 1) = ar '¼g¤JÀx¦s®æ
    
20. f.Close 'Ãö³¬¤å¦rÀÉ
    
21. fs = Dir '¤U¤@­ÓÀɦW
    
22. Loop
    
23. End Sub

½Æ»s¥N½X