ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¦bc:\file\¤U¦³1.txt,2.txt....¤£¤@©w¦³´X­ÓÀÉ®×,ÀɦW¬°¼Æ¦r»¼¼W. ¨C­ÓÀɮ׮榡³£¬Û¦P,¦p¤U:
¨Ò¦p: 1.txt
¦W¦r ¤ýxx
¼Æ¾Ç 58
­^¤å 63
¦a²z 90
¤Æ¾Ç 80

2.txt
¦W¦r ªLx
¼Æ¾Ç 100
­^¤å 6
¦a²z 60
¤Æ¾Ç  58

txt¤¤©T©w³£¬O5 rows, 2 columns, column¶¡¥ÎªÅ®æ®æ¶}, ­n¥Î°j°é±Nc:\file\¤Uªº50­ÓÀÉ®×Ū¤JExcel,¨ÃÂà¸m¦¨¤U,row 1©T©w¬OÄæ¦ì¦WºÙ, row 2¶}©l¤À§OŪ¤J©Ò¦³ÀÉÂà¸m, ¦ý¥uŪ¨ì¦a²z, ¤£Åª¤J¤Æ¾Ç¨º¤@row¸ê®Æ.
¦W¦r ¼Æ¾Ç ­^¤å ¦a²z
¤ýxx 58 63 90
ªLx 100 6 60
.
.
.
¨ì³Ì«átxt¨ºµ§

³Ì«á¦s¦¨c:\file\final.xls

·PÁÂ!

¦^´_ 1# alexsas38
  1. Sub TEST()
  2.     Dim fd, f, fo
  3.    
  4.     With Workbooks.Add
  5.         '¼ÐÃD¦C
  6.         .Sheets(1).Range("A1:D1") = Array("¦W¦r", "¼Æ¾Ç", "­^¤å", "¦a²z")
  7.         '·s¼W¼È¦s¸ê®Æªí
  8.         With .Sheets.Add(after:=.Sheets(.Sheets.Count))
  9.             'ÂsÄý¿ï¾Ü¸ê®Æ§¨
  10.             With Application.FileDialog(msoFileDialogFolderPicker)
  11.                 .AllowMultiSelect = False
  12.                 If .Show = -1 Then fd = .SelectedItems(1) & "\"
  13.             End With
  14.             '¹ï©Ò¦³¸Ó¸ê®Æ§¨¤Uªºtxt³B²z
  15.             f = Dir(fd & "*.txt")
  16.             Do While f <> ""
  17.                 .Cells.ClearContents
  18.                 '¶×¤J¥~³¡¸ê®Æ
  19.                 With .QueryTables.Add(Connection:="TEXT;" & fd & f, Destination:=.Range("A1"))
  20.                     .Name = "¦¨ÁZ"
  21.                     .RefreshPeriod = 0
  22.                     .TextFileParseType = xlDelimited
  23.                     .TextFileConsecutiveDelimiter = True
  24.                     .TextFileTabDelimiter = True    'TabÁ䬰¤À³Î¦r¤¸
  25.                     .TextFileSemicolonDelimiter = False
  26.                     .TextFileCommaDelimiter = False
  27.                     .TextFileSpaceDelimiter = True  'ªÅ¥ÕÁ䬰¤À³Î¦r¤¸
  28.                     .Refresh BackgroundQuery:=False
  29.                 End With
  30.                 '§R°£¸ê®Æ³s½u
  31.                 .Cells.QueryTable.Delete
  32.                 '·s¼W¸ê®Æ¨ì²Ä¤@­Ó¤u§@ªí
  33.                 .Parent.Sheets(1).Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = Application.Transpose(.Range("B1:B4").Value)
  34.                 f = Dir
  35.             Loop
  36.             '§R°£¼È¦s¸ê®Æªí,¤£Åã¥Üĵ§iµøµ¡
  37.             Application.DisplayAlerts = False
  38.             .Delete
  39.             Application.DisplayAlerts = True
  40.         End With
  41.         .Sheets(1).Activate '¨Ï¶}±Ò¸ÓÀɮɪ½±µ¨ì²Ä¤@­Ó¤u§@ªí
  42.         '¦sÀÉ
  43.         fo = Application.GetSaveAsFilename(InitialFileName:=fd & "final.xls", FileFilter:="Excel Files (*.xls),*.xls", Title:="Àx¦sÀÉ®×")
  44.         '°£«D«ö¨ú®ø, §_«h¦sÀÉ
  45.         If TypeName(fo) = "String" Then .SaveAs Filename:=fo, FileFormat:=xlExcel8
  46.     End With
  47. End Sub
½Æ»s¥N½X

TOP

stillfish00±z¦n, ­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 )
.
.
.
®Ú¾Ú±zªºµ{¦¡­×§ï¦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~

TOP

¦^´_ 2# stillfish00
ÁÂÁÂ, ¦ý¬O¸ê®Æ§ïÅÜ«á, ·|¦]¬°0©MªÅ¥Õ³y¦¨°ÝÃD, ·Q¦A¦V±z½Ð±Ð, ·PÁ±z!

TOP

¦^´_ 4# alexsas38
³o¼ËÀÉ®×¥u¯à¦Û¤v¥ÎSplit­åªR¡G
  1. Sub TEST()
  2.     Dim fd, f, fo
  3.     Dim ar(), fnum As Integer, i, s
  4.     Dim arData() As String, dataLine As String
  5.    
  6.     ReDim ar(0)
  7.     ar(0) = Array("Àç·~¤H²Î¤@½s¸¹", "­t³d¤H©m¦W", "Àç·~¤H¦WºÙ", "Àç·~¡]µ|Äy¡^µn°O¦a§}", "¸ê¥»ÃB(¤¸)", "²Õ´ºØÃþ", "³]¥ß¤é´Á", "µn°OÀç·~¶µ¥Ø")
  8.    
  9.     With Workbooks.Add
  10.         'ÂsÄý¿ï¾Ü¸ê®Æ§¨
  11.         With Application.FileDialog(msoFileDialogFolderPicker)
  12.             If .Show = -1 Then
  13.                 If .SelectedItems.Count > 0 Then fd = .SelectedItems(1) & "\"
  14.             Else
  15.                 Exit Sub    '¨ú®ø
  16.             End If
  17.         End With
  18.         '¹ï©Ò¦³¸Ó¸ê®Æ§¨¤Uªºtxt³B²z
  19.         f = Dir(fd & "*.txt")
  20.         Do While f <> ""
  21.             'Ū¨úÀÉ®×
  22.             fnum = FreeFile
  23.             Open fd & f For Input As #fnum
  24.             '¥ÎSplit­åªR«e¤K¦æ¸ê®Æ
  25.             ReDim arData(0 To 7)
  26.             For i = 0 To 7
  27.                 If EOF(fnum) Then Exit For  '­YÀÉ®×¥¼¹F¤K¦æ«h¸õ¥X
  28.                 Line Input #fnum, dataLine
  29.                 s = Split(dataLine, " ", 2)     '­­¨î³Ì¦h¶Ç¦^ªº¤l¦r¦ê¼Æ¬°2­Ó
  30.                 If UBound(s) = 1 Then arData(i) = s(1)
  31.             Next
  32.             ReDim Preserve ar(UBound(ar) + 1)   '«O¯d¨Ã¼W¤j°}¦C
  33.             ar(UBound(ar)) = arData
  34.             Close #fnum     '°O±oÃöÀÉ®×
  35.             f = Dir
  36.         Loop
  37.         With .Sheets(1)
  38.             .Columns("A:A").NumberFormatLocal = "@"     'AÄæ®æ¦¡³]¬°¤å¦r
  39.             .Range("A1").Resize(UBound(ar) + 1, 8).Value = Application.Transpose(Application.Transpose(ar))   '¶ñ¤J¸ê®Æ
  40.             .Range("A1").Resize(UBound(ar) + 1, 8).EntireColumn.AutoFit   '½Õ¾ãÄæ¼e
  41.         End With
  42.         '¦sÀÉ
  43.         fo = Application.GetSaveAsFilename(InitialFileName:=fd & "final.xls", FileFilter:="Excel Files (*.xls),*.xls", Title:="Àx¦sÀÉ®×")
  44.         '°£«D«ö¨ú®ø, §_«h¦sÀÉ
  45.         If TypeName(fo) = "String" Then .SaveAs Filename:=fo, FileFormat:=xlExcel8
  46.     End With
  47. End Sub
½Æ»s¥N½X

TOP

¦^´_ 5# stillfish00
·PÁ±z, §Ú«á¨Ó¥Îlen°µªø«×§PÂ_,¦A¥[¤W¥Î&°µ¦X¨Öªº¤è¦¡¸Ñ¨M,¦ýÁÙ¬O±zªº°µªk¬O¤ñ¸ûeffective. Thanks.

TOP

        ÀR«ä¦Û¦b : ¤â¤ß¦V¤U¬O§U¤H¡A¤â¤ß¦V¤W¬O¨D¤H¡F§U¤H§Ö¼Ö¡A¨D¤Hµh­W¡C
ªð¦^¦Cªí ¤W¤@¥DÃD