Gộp Nhiều File Text Thành 1 File Excel - TỔNG HỢP KINH NGHIỆM

Nếu bạn đang tìm công cụ có thể đồng thời import nhiều file text đuôi .txt vào một file excel chỉ với một click chuột, thì bài viết này dành cho bạn

Sau khi tải file về bạn chỉ cần ấn nút dẫn tới đường dẫn folder chứa file text

Công cụ sẽ tự động insert tất cả các file text trong thư mục đó vào file excel, mỗi file text được insert vào một sheet riêng biệt

Tải công cụ tại đây

TẢI CÔNG CỤ

Hoặc sử dụng code VBA :

Sub CombineTextFiles() 'updateby Extendoffice Dim xFilesToOpen As Variant Dim I As Integer Dim xWb As Workbook Dim xTempWb As Workbook Dim xDelimiter As String Dim xScreen As Boolean On Error GoTo ErrHandler xScreen = Application.ScreenUpdating Application.ScreenUpdating = False xDelimiter = "|" xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Kutools for Excel", , True) If TypeName(xFilesToOpen) = "Boolean" Then MsgBox "No files were selected", , "Kutools for Excel" GoTo ExitHandler End If I = 1 Set xTempWb = Workbooks.Open(xFilesToOpen(I)) xTempWb.Sheets(1).Copy Set xWb = Application.ActiveWorkbook xTempWb.Close False xWb.Worksheets(I).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:="|" Do While I < UBound(xFilesToOpen) I = I + 1 Set xTempWb = Workbooks.Open(xFilesToOpen(I)) With xWb xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count) .Worksheets(I).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:=xDelimiter End With Loop ExitHandler: Application.ScreenUpdating = xScreen Set xWb = Nothing Set xTempWb = Nothing Exit Sub ErrHandler: MsgBox Err.Description, , "Kutools for Excel" Resume ExitHandler End Sub

Nếu bạn muốn gộp nhiều file text thành một sheet duy nhất thì có thể tải công cụ tại đây

TẢI CÔNG CỤ

hoặc code VBA

Sub ImportTXTFiles() Dim fso As Object Dim xlsheet As Worksheet Dim qt As QueryTable Dim txtfilesToOpen As Variant, txtfile As Variant Application.ScreenUpdating = False Set fso = CreateObject("Scripting.FileSystemObject") txtfilesToOpen = Application.GetOpenFilename _ (FileFilter:="Text Files (*.txt), *.txt", _ MultiSelect:=True, Title:="Text Files to Open") With ActiveSheet For Each txtfile In txtfilesToOpen importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row ' IMPORT DATA FROM TEXT FILE With .QueryTables.Add(Connection:="TEXT;" & txtfile, _ Destination:=.Cells(importrow, 1)) .TextFileParseType = xlDelimited .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileOtherDelimiter = "|" .Refresh BackgroundQuery:=False End With Next txtfile For Each qt In .QueryTables qt.Delete Next qt End With Application.ScreenUpdating = True MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT" Set fso = Nothing End Sub

Facebook Comments