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

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

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

­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~

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

  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 path = .SelectedItems(1) & "\"

  13.             End With

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

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

  16.             Do While folder <> ""

  17.                 .Cells.ClearContents
  18.                 .Columns(2).NumberFormat = "@"
  19.                
  20.                 '¶×¤J¥~³¡¸ê®Æ

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

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

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

  25.                     .Refresh BackgroundQuery:=False

  26.                 End With

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

  28.                 .Cells.QueryTable.Delete
  29.                
  30.                 lRow = .Cells(Rows.Count, 1).End(xlUp).Row
  31.                 For lI = 1 To lRow
  32.                   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) = ""
  33.                   If .Cells(lI, 3) <> "" Then .Cells(lI, 2) = .Cells(lI, 2) & " " & .Cells(lI, 3) & " " & .Cells(lI, 4): .Cells(lI, 3) = "": .Cells(lI, 4) = ""
  34.                 Next lI

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

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

  37.                 folder = Dir

  38.             Loop

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

  40.             Application.DisplayAlerts = False

  41.             .Delete

  42.             Application.DisplayAlerts = True

  43.         End With

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

  45.         '¦sÀÉ

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

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

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

  49.     End With

  50. End Sub
½Æ»s¥N½X

TOP

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ¤Hªº²´·úªø¦b«e­±¡A¥u¬Ý¨ì§O¤Hªº¯ÊÂI¡Aµ·²@¬Ý¤£¨ì¦Û¤vªº¯ÊÂI¡C
ªð¦^¦Cªí ¤W¤@¥DÃD