Hỏi về VBA cách lấy dự liệu từ file *.txt

duongrcfee · 9/7/14

Xin chào mọi người!
Mình có một vấn đề mong được cả nhà chỉ giáo!
Mình muốn dùng VBA để lấy dữ liêu từ file *.txt, mình đã tham khảo bài viết của một bạn trong diễn dần với code như sau:

Option Explicit
Sub Main()
Dim sFolder, txtFile As String, sWksName As String
Dim aFiles, Arr, wkbNew As Workbook
Dim lCount As Long, i As Long, n As Long, lWksCount As Long
On Error Resume Next
With CreateObject("Shell.Application")
sFolder = .BrowseForFolder(0, "", 1).Self.Path
End With
If TypeName(sFolder) = "String" Then
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
aFiles = GetListFile(sFolder, "*.txt", False)
If IsArray(aFiles) Then
lCount = UBound(aFiles) + 1
ReDim Arr(1 To lCount)
Set wkbNew = Workbooks.Add
With wkbNew
lWksCount = lCount - .Sheets.Count
If lWksCount > 0 Then
.Worksheets.Add After:=.Sheets(.Sheets.Count), Count:=lWksCount
End If
End With
With CreateObject("Scripting.FileSystemObject")
For i = 0 To UBound(aFiles)
txtFile = sFolder & aFiles(i)
sWksName = Left(aFiles(i), InStrRev(aFiles(i), ".") - 1)
n = n + 1
Arr = GetValFromTxt(txtFile)
With wkbNew.Sheets(n)
.Range("A1").Resize(UBound(Arr)).Value = Arr
.Name = Left(sWksName, 31)
End With
Next
End With
End If
End If
End Sub
Function GetValFromTxt(ByVal txtFile As String)
Dim tmpArr, Arr()
Dim n As Long, i As Long
On Error Resume Next
With CreateObject("Scripting.FileSystemObject")
If .FileExists(txtFile) Then
With .OpenTextFile(txtFile, 1, , -2)
tmpArr = Split(.ReadAll, vbCrLf)
If IsArray(tmpArr) Then
ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
For i = 0 To UBound(tmpArr)
n = n + 1
Arr(n, 1) = CStr(tmpArr(i))
Next
If n Then GetValFromTxt = Arr
End If
.Close
End With
End If
End With
End Function
Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
Dim sComm As String, tmp As String, tmpFile, Arr
On Error Resume Next
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
Folder = """" & Folder & """"
With CreateObject("Scripting.FileSystemObject")
tmpFile = .GetTempName
sComm = "DIR " & Folder & Search & " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
With .OpenTextFile(tmpFile, 1, , -2)
tmp = Trim(.ReadAll)
If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
If Len(tmp) Then GetListFile = Split(tmp, vbCrLf)
.Close
End With
End With
Kill tmpFile
End Function

Nhưng mình muốn chỉnh sửa một chút mong mọi nguời giúp đỡ:
- Mình muốn lấy dữ liệu từ file *.txt vào sheet2 (hoặc sửa tên là data) chứ không mở 1 flie mới
- Các file *.txt khi đưa vào sẽ nằm trong 1 sheet
- Dữ liệu đưa vào thành dạng bảng
- Và thêm code để tự động save
Rất mong nhận được sự giúp đỡ của mọi người
Chân thành cảm ơn!
PS: Mình gửi cả file đính kèm nhé)

duongrcfee · 11/7/14

Không ai giúp mình ak?

siwtom · 12/7/14

duongrcfee đã viết:
Xin chào mọi người!
Mình có một vấn đề mong được cả nhà chỉ giáo!
Mình muốn dùng VBA để lấy dữ liêu từ file *.txt, mình đã tham khảo bài viết của một bạn trong diễn dần với code như sau:
..........
Nhưng mình muốn chỉnh sửa một chút mong mọi nguời giúp đỡ:
- Mình muốn lấy dữ liệu từ file *.txt vào sheet2 (hoặc sửa tên là data) chứ không mở 1 flie mới
- Các file *.txt khi đưa vào sẽ nằm trong 1 sheet
- Dữ liệu đưa vào thành dạng bảng
- Và thêm code để tự động save
Rất mong nhận được sự giúp đỡ của mọi người
Chân thành cảm ơn!
PS: Mình gửi cả file đính kèm nhé)

Bạn không dùng code trên được vì:
1. code tạo tập tin mới và cho dữ liệu mỗi tập tin vào một sheet. Cái này bạn đã nêu.
2. code không tách mỗi dòng dữ liệu thành các cột. Code lấy toàn bộ dòng để nhập xuống một ô trên sheet. Như vậy nếu bạn có mỗi dòng là dữ liệu cách nhau bởi TAB thì toàn bộ dữ liệu trên cell nhìn như bị "dính vào nhau" do TAB không phải là ký tự hiển thị và in thấy được.
3. Code không loại các dòng trống và các dòng chỉ có toàn TAB (như là dòng cuối cùng trong Danhsach01.txt) mà tôi nhìn kết quả mong đợi của bạn thì bạn loại các dòng chỉ có toàn TAB, và như vậy tôi nghĩ là bạn loại cả các dòng trống. Vậy nếu tập tin text chỉ có 100 dòng trống thì có 1 sheet rỗng được tạo. Nếu dòng 100 có dữ liệu thì trên sheet có 99 dòng trống và sau đó 1 dòng có dữ liệu.
-------------
Tôi không biết bạn lấy dữ liệu từ đâu để nhập vào sheet Data vì tôi nhìn các tập tin txt thì không hẳn là dùng mã TCVN3. Tôi không quan tâm chuyện này vì tôi rất dị ứng với TCVN3 và VNI. THời buổi nào mà vẫn còn dùng các mã đó. Tôi không giúp bạn về chuyện này vì nguyên tắc của tôi không tiếp tay cho bất cứ ai trong chuyện dùng mã <> unicode.
-----------
0. Tôi không cho bạn chọn thư mục mà cho chọn các tập tin vì tôi nghĩ như thế linh động hơn. Không phải luôn luôn ta đều muốn nhập tất cả các tập tin có trong thư mục. Bạn có thể chọn 1, nhiều hoặc tất cả trong thư mục.
1. Alt+F11 --> Insert --> Module --> dán code dưới đây vào Module1
2. Gán cho "nút" macro ImportTextFiles --> lưu lại với tên là Tonghop.xlsm

Bắt đầu từ lúc này mỗi lần nhấn "nút" thì code trước hết xóa dữ liệu cũ và thay bằng dữ liệu các tập tin bạn chọn và lưu tập tin. Nếu bạn không muốn mất dữ liệu cũ thì có thể xóa dòng đỏ đỏ trong code dưới đây. Nhưng lúc đó nếu dữ liệu mới có ít dòng hơn thì những dòng cuối sẽ là dữ liệu cũ và bạn không biết được dữ liệu mới tới đâu. Nói chung có nhiều cách xử lý. Vd. lưu dữ liệu cũ sang sheet mới. Nhưng tôi đề nghị xóa dòng xanh xanh trong code. Việc lưu tập tin đâu có khổ nhọc mà phải lười tới mức dùng code. Bạn chạy code không thấy sai sót, nhầm lẫn, sau đó kiểm tra cẩn thận, uốn lưỡi 7 lần rồi mới tự lưu thì vẫn tốt hơn. Dùng code nếu sai không bập bập được.

Mã:

Sub ImportTextFiles()
Dim index As Long, r As Long, c As Long, n As Long, linecount As Long, text As String
Dim rng As Range, fso As Object, ts As Object, Arr(), files, lines, items
    files = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
    If IsArray(files) Then
        [B][COLOR=#ff0000]Sheets("Data").Range("A2:A65536").EntireRow.ClearContents[/COLOR][/B]
        Set rng = Sheets("Data").Range("A2")
        Set fso = CreateObject("Scripting.FileSystemObject")
        For index = LBound(files) To UBound(files)
            n = 0
            Set ts = fso.OpenTextFile(files(index), 1, , -2)
            lines = Split(ts.ReadAll, vbCrLf)
            If UBound(lines) > 0 Then
                linecount = UBound(lines)
                ReDim Arr(1 To linecount, 1 To 1)
                For r = 1 To linecount
                    text = lines(r)
                    If text <> "" Then
                        If text <> String(Len(text), vbTab) Then
                            n = n + 1
                            items = Split(text, vbTab)
                            If UBound(Arr, 2) < UBound(items) + 1 Then ReDim Preserve Arr(1 To linecount, 1 To UBound(items) + 1)
                            For c = 1 To UBound(Arr, 2)
                                Arr(n, c) = items(c - 1)
                            Next c
                        End If
                    End If
                Next r
            End If
            If n Then
                rng.Resize(n, UBound(Arr, 2)).Value = Arr
                Set rng = rng.Offset(n)
            End If
        Next index
        Set ts = Nothing
        Set fso = Nothing
        
        [B][COLOR=#0000ff]ThisWorkbook.Save[/COLOR][/B]
    End If
End Sub

Quang_Hải · 12/7/14

siwtom đã viết:

Mã:

Sub ImportTextFiles()
Dim index As Long, r As Long, c As Long, n As Long, linecount As Long, text As String
Dim rng As Range, fso As Object, ts As Object, Arr(), files, lines, items
    files = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
    If IsArray(files) Then
        [B][COLOR=#ff0000]Sheets("Data").Range("A2:A65536").EntireRow.ClearContents[/COLOR][/B]
        Set rng = Sheets("Data").Range("A2")
        Set fso = CreateObject("Scripting.FileSystemObject")
        For index = LBound(files) To UBound(files)
            n = 0
            Set ts = fso.OpenTextFile(files(index), 1, , -2)
            lines = Split(ts.ReadAll, vbCrLf)
            If UBound(lines) > 0 Then
                linecount = UBound(lines)
                ReDim Arr(1 To linecount, 1 To 1)
                For r = 1 To linecount
                    text = lines(r)
                    If text <> "" Then
                        If text <> String(Len(text), vbTab) Then
                            n = n + 1
                            items = Split(text, vbTab)
                            If UBound(Arr, 2) < UBound(items) + 1 Then ReDim Preserve Arr(1 To linecount, 1 To UBound(items) + 1)
                            For c = 1 To UBound(Arr, 2)
                                Arr(n, c) = items(c - 1)
                            Next c
                        End If
                    End If
                Next r
            End If
            If n Then
                rng.Resize(n, UBound(Arr, 2)).Value = Arr
                Set rng = rng.Offset(n)
            End If
        Next index
        Set ts = Nothing
        Set fso = Nothing
        
        [B][COLOR=#0000ff]ThisWorkbook.Save[/COLOR][/B]
    End If
End Sub

Em học được rất nhiều code từ những đoạn code của anh, chỉ có dạng code này là chưa nếm qua nên cứ thấy import từ file text là sợ. Nhưng đoạn code hôm nay dường như dễ hiểu hơn, hy vọng sẽ học được từ đoạn code này.

duongrcfee · 13/7/14

Cám ơn bạn rất nhiều!
Bạn giúp mình đưa thêm dòng code xoá ký tự " " trong file *.text khi đưa vào sheet (data) nhé!
Tại file text của mình khi Import vào sheet có dạng "vidu" mình muốn bỏ dấu " đi à!

Quang_Hải · 13/7/14

duongrcfee đã viết:
Cám ơn bạn rất nhiều!
Bạn giúp mình đưa thêm dòng code xoá ký tự " " trong file *.text khi đưa vào sheet (data) nhé!
Tại file text của mình khi Import vào sheet có dạng "vidu" mình muốn bỏ dấu " đi à!

Có thể dùng chức năng chuyển mã của bộ gõ UNI sau khi import dữ liệu, không thể dùng chức năng Find and Replace được đâu

siwtom · 13/7/14

duongrcfee đã viết:
Cám ơn bạn rất nhiều!
Bạn giúp mình đưa thêm dòng code xoá ký tự " " trong file *.text khi đưa vào sheet (data) nhé!
Tại file text của mình khi Import vào sheet có dạng "vidu" mình muốn bỏ dấu " đi à!

Trong các tập tin txt bạn gửi làm gì có ký tự "?
Nếu trong các tập tin khác có thì chúng ở đâu? Tôi không hình dung được dữ liệu kiểu "D340301", "123", "Đặng Lệ Thu", "28/03/95" ...
Cứ phải có tập tin chứ nói mồm không được.

Quang_Hải · 13/7/14

Gởi anh Siwtom

Em đã giải mã được đoạn code của anh, và thử điều chỉnh lại các biến. Nhưng đến đoạn code xanh xanh em không hiểu được ý nghĩa của nó. Anh giải thích giúp em. Code này em viết bỏ bớt đoạn cuối, chủ yếu là em hiểu thuật toán để ứng dụng cho bài khác.

Mã:

Sub ImportTextFile()
Dim Index As Long, n As Long, col As Long, row As Long, Text As String
Dim Rng As Range, FSO As Object, FilesToImport
Dim TextSource As Object, NumOfLines, Cols, Res()
Sheets("Data").Range("A2:S65536").ClearContents
Set Rng = Sheets("Data").Range("A2")
FilesToImport = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If IsArray(FilesToImport) Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Index = 1 To UBound(FilesToImport)
        n = 0
        Set TextSource = FSO.OpenTextFile(FilesToImport(Index), 1, , -2)
        NumOfLines = Split(TextSource.ReadAll, vbCrLf)
        ReDim Res(1 To UBound(NumOfLines), 1 To 1)
        For row = 1 To UBound(NumOfLines)
            Text = NumOfLines(row)
            If Text <> "" Then
                [COLOR=#0000ff]If Text <> String(Len(Text), vbTab) Then[/COLOR]
                    n = n + 1
                    Cols = Split(Text, vbTab)
                    If UBound(Res, 2) < UBound(Cols) + 1 Then
                        ReDim Preserve Res(1 To UBound(NumOfLines), 1 To UBound(Cols) + 1)
                    End If
                    For col = 1 To UBound(Res, 2)
                        Res(n, col) = Cols(col - 1)
                    Next
                End If
            End If
        Next
        Rng.Resize(n, UBound(Res, 2)).Value = Res
        Set Rng = Rng.Offset(n)
    Next
End If
End Sub

duongrcfee · 13/7/14

Inporttext bằng VBA

Cám ơn bạn đã giúp đỡ!
Bạn thêm đoạn code bỏ dấu " cho mình nhé!
File *.text đính kèm đây!

siwtom · 13/7/14

quanghai1969 đã viết:

Gởi anh Siwtom

Em đã giải mã được đoạn code của anh, và thử điều chỉnh lại các biến. Nhưng đến đoạn code xanh xanh em không hiểu được ý nghĩa của nó. Anh giải thích giúp em. Code này em viết bỏ bớt đoạn cuối, chủ yếu là em hiểu thuật toán để ứng dụng cho bài khác.

Mã:

Sub ImportTextFile()
Dim Index As Long, n As Long, col As Long, row As Long, Text As String
Dim Rng As Range, FSO As Object, FilesToImport
Dim TextSource As Object, NumOfLines, Cols, Res()
Sheets("Data").Range("A2:S65536").ClearContents
Set Rng = Sheets("Data").Range("A2")
FilesToImport = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If IsArray(FilesToImport) Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Index = 1 To UBound(FilesToImport)
        n = 0
        Set TextSource = FSO.OpenTextFile(FilesToImport(Index), 1, , -2)
        NumOfLines = Split(TextSource.ReadAll, vbCrLf)
        ReDim Res(1 To UBound(NumOfLines), 1 To 1)
        For row = 1 To UBound(NumOfLines)
            Text = NumOfLines(row)
            If Text <> "" Then
                [COLOR=#0000ff]If Text <> String(Len(Text), vbTab) Then[/COLOR]
                    n = n + 1
                    Cols = Split(Text, vbTab)
                    If UBound(Res, 2) < UBound(Cols) + 1 Then
                        ReDim Preserve Res(1 To UBound(NumOfLines), 1 To UBound(Cols) + 1)
                    End If
                    For col = 1 To UBound(Res, 2)
                        Res(n, col) = Cols(col - 1)
                    Next
                End If
            End If
        Next
        Rng.Resize(n, UBound(Res, 2)).Value = Res
        Set Rng = Rng.Offset(n)
    Next
End If
End Sub

Giả sử Text có k ký tự => String(Len(Text), vbTab) = chuỗi có k ký tự TAB
=> If Text <> String(Len(Text), vbTab) Then có nghĩa là "Nếu Text không phải là chuỗi toàn ký tự TAB thì". Nói cách khác nếu Text là ký tự toàn TAB (k ký tự TAB) thì không làm gì cả.

Tôi thêm cái này là do dữ liệu của người hỏi có dòng toàn TAB - tập tin Danhsach01.txt có dòng cuối toàn TAB. Bạn thử bỏ 2 dòng đỏ đỏ của code dưới rồi khi chạy code chọn cả 3 tập tin (chọn tập tin Danhsach03.txt --> giữ Shift --> chon Danhsach01.txt) thì sẽ thấy dòng 448 của sheet Data trống

Mã:

[COLOR=#ff0000]If text <> String(Len(text), vbTab) Then[/COLOR]
    n = n + 1
    items = Split(text, vbTab)
    If UBound(Arr, 2) < UBound(items) + 1 Then ReDim Preserve Arr(1 To linecount, 1 To UBound(items) + 1)
    For c = 1 To UBound(Arr, 2)
        Arr(n, c) = items(c - 1)
    Next c
[COLOR=#ff0000]End If[/COLOR]

Trong code còn có If UBound(lines) > 0 Then, tức nếu tập tin có ít nhất 2 dòng thì mới thao tác. Đó cũng do đặc thù dữ liệu của người hỏi là dòng đầu tiên là tiêu đề. Nếu tập tin chỉ có tiêu đề thôi thì UBound(lines) = UBound(lines) = 0 và lúc đó bỏ qua tập tin đó.

Ngoài ra code không lấy số cột của dòng đầu để làm số cột của mảng Arr trong một lần Redim duy nhất mà dùng Redim Preserve khi dòng hiện hành có số cột có dữ liệu lớn hơn số cột hiện có trong Arr. Tôi làm thế để lường trường hợp dữ liệu đặc thù: không phải là dòng nào cũng có đủ dữ liệu, cho phép có cột trống

siwtom · 13/7/14

duongrcfee đã viết:
Cám ơn bạn đã giúp đỡ!
Bạn thêm đoạn code bỏ dấu " cho mình nhé!
File *.text đính kèm đây!

Trong code tôi đưa bạn tìm dòng

Mã:

lines = Split(ts.ReadAll, vbCrLf)

và thay bằng

Mã:

lines = Split([B][COLOR=#ff0000]Replace([/COLOR][/B]ts.ReadAll[B][COLOR=#ff0000], Chr(34), "")[/COLOR][/B], vbCrLf)

Đỏ đỏ là mới thêm vào

Quang_Hải · 13/7/14

duongrcfee đã viết:
Cám ơn bạn đã giúp đỡ!
Bạn thêm đoạn code bỏ dấu " cho mình nhé!
File *.text đính kèm đây!

Xin phép anh Siwtom cho em mượn code của anh để trả lời bài này, coi như thực hành kiến thức vừa mới học của anh.

PHP:

Sub ImportTextFile()
Dim Index As Long, n As Long, col As Long, row As Long, Text As String
Dim Rng As Range, FSO As Object, FilesToImport
Dim TextSource As Object, NumOfLines, Cols, Res()
Sheets("Data").Range("A2:S65536").ClearContents
Set Rng = Sheets("Data").Range("A2")
FilesToImport = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If IsArray(FilesToImport) Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Index = 1 To UBound(FilesToImport)
        n = 0
        Set TextSource = FSO.OpenTextFile(FilesToImport(Index), 1, , -2)
        NumOfLines = Split(TextSource.ReadAll, vbCrLf)
        If UBound(NumOfLines) > 0 Then
            ReDim Res(1 To UBound(NumOfLines), 1 To 1)
            For row = 1 To UBound(NumOfLines)
                Text = NumOfLines(row)
                If Text <> "" Then
                    If Text <> String(Len(Text), vbTab) Then
                        n = n + 1
                        Cols = Split(Text, vbTab)
                        If UBound(Res, 2) < UBound(Cols) + 1 Then
                            ReDim Preserve Res(1 To UBound(NumOfLines), 1 To UBound(Cols) + 1)
                        End If
                        For col = 1 To UBound(Res, 2)
                            Res(n, col) = Replace(Cols(col - 1), """", "")
                        Next
                    End If
                End If
            Next
        End If
        Rng.Resize(n, UBound(Res, 2)).Value = Res
        Set Rng = Rng.Offset(n)
    Next
End If
End Sub

Quang_Hải · 13/7/14

siwtom đã viết:
Trong code tôi đưa bạn tìm dòng

Mã:

lines = Split(ts.ReadAll, vbCrLf)

và thay bằng

Mã:

lines = Split([B][COLOR=#ff0000]Replace([/COLOR][/B]ts.ReadAll[B][COLOR=#ff0000], Chr(34), "")[/COLOR][/B], vbCrLf)

Đỏ đỏ là mới thêm vào

Em vừa trả lời bài thì mới thấy bài của anh, lại là 1 kiến thức mới nữa. Anh xử lý ngay lúc nạp dữ liệu.

duongrcfee · 15/7/14

[h=2]siwtom ơi! Minh gửi file text roi đấy giúp mình nhé[/h]

siwtom · 15/7/14

duongrcfee đã viết:
siwtom ơi! Minh gửi file text roi đấy giúp mình nhé

Bạn không đọc bài #11 của tôi à?

NguyenThienHa · 22/7/15

Gửi anh Siwtom mọi người trên diễn đàn
Mình có lấy code của anh Siwtom lấy thử 1 file txt thì bị lỗi Run-time error '9' Subscript out of range
Mong anh Siwtom cùng mọi người xem thử sao lại bị vậy
Cám ơn mọi người

dhn46 · 24/7/15

NguyenThienHa đã viết:
Gửi anh Siwtom mọi người trên diễn đàn
Mình có lấy code của anh Siwtom lấy thử 1 file txt thì bị lỗi Run-time error '9' Subscript out of range
Mong anh Siwtom cùng mọi người xem thử sao lại bị vậy
Cám ơn mọi người

Trong khi chờ thông tin từ các thành viên khác bạn hãy làm như sau:

Sửa đoạn:

Mã:

For c = 1 To UBound(Arr, 2)

thành:

Mã:

For c = 1 To UBound(items) + 1

thenguyen007 · 9/9/16

code cuûa anh siwtom rất hay, nhưng anh có thể chỉnh lại code để khi lấy data từ file txt thì mỗi file txt chỉ lấy 1 số cột do mình chỉ định không? và theo thứ tự mình muốn đưa vào excel không.
thanks!

khanhhero · 20/5/19

siwtom đã viết:
Giả sử Text có k ký tự => String(Len(Text), vbTab) = chuỗi có k ký tự TAB
=> If Text <> String(Len(Text), vbTab) Then có nghĩa là "Nếu Text không phải là chuỗi toàn ký tự TAB thì". Nói cách khác nếu Text là ký tự toàn TAB (k ký tự TAB) thì không làm gì cả.

Tôi thêm cái này là do dữ liệu của người hỏi có dòng toàn TAB - tập tin Danhsach01.txt có dòng cuối toàn TAB. Bạn thử bỏ 2 dòng đỏ đỏ của code dưới rồi khi chạy code chọn cả 3 tập tin (chọn tập tin Danhsach03.txt --> giữ Shift --> chon Danhsach01.txt) thì sẽ thấy dòng 448 của sheet Data trống

Mã:

[COLOR=#ff0000]If text <> String(Len(text), vbTab) Then[/COLOR] n = n + 1 items = Split(text, vbTab) If UBound(Arr, 2) < UBound(items) + 1 Then ReDim Preserve Arr(1 To linecount, 1 To UBound(items) + 1) For c = 1 To UBound(Arr, 2) Arr(n, c) = items(c - 1) Next c [COLOR=#ff0000]End If[/COLOR]

Trong code còn có If UBound(lines) > 0 Then, tức nếu tập tin có ít nhất 2 dòng thì mới thao tác. Đó cũng do đặc thù dữ liệu của người hỏi là dòng đầu tiên là tiêu đề. Nếu tập tin chỉ có tiêu đề thôi thì UBound(lines) = UBound(lines) = 0 và lúc đó bỏ qua tập tin đó.

Ngoài ra code không lấy số cột của dòng đầu để làm số cột của mảng Arr trong một lần Redim duy nhất mà dùng Redim Preserve khi dòng hiện hành có số cột có dữ liệu lớn hơn số cột hiện có trong Arr. Tôi làm thế để lường trường hợp dữ liệu đặc thù: không phải là dòng nào cũng có đủ dữ liệu, cho phép có cột trống

Bác cho em hỏi là nếu muốn lấy luôn cả tiêu đề của file text thì phải làm ntn ạ? vì em sửa if Ubound(lines) >=0 then nó vẫn ko lấy tiêu đề. Em cám ơn bác.

khanhhero · 20/5/19

befaint đã viết:
"làm nờ tê nờ" là làm cái gì? Tiêu đề của file là tên của file đó hả?

Dạ ý em là lấy luôn dòng đầu tiên trong dữ liệu file text đó anh. Code này dòng đầu tiên của bảng dữ liệu đc xem là tiêu đề nên chỉ lấy từ dòng thứ 2 trở đi.

Hỏi về VBA cách lấy dự liệu từ file *.txt

Thành viên mới

File đính kèm

Thành viên mới

Thành viên gắn bó

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên gắn bó

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên gắn bó

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

Hướng tới tương lai

Thành viên mới

Thành viên hoạt động

Thành viên hoạt động

Đếm ngược thời gian