Lấy các đoạn văn bản trong file text vào từng dòng trong excel

[giauvn]

Xin chào các bạn như tiêu đề trên.
Mình có rất nhiều file dạng *.txt bên trong chứa các dòng văn bản gần giống nhau.
Nội dung nó tương đồng vối 5 file mình đính kèm.
Mình muốn lấy chuỗi văn bản trong file text đó từ dòng thứ 31 đến dòng 200 cho nó ra từng dòng trong excel.
Mỗi nội dung văn bản trong file text sẽ cho ra excel liên tiếp các dòng nối đuôi nhau trong 1 cột ví dụ là cột D chẳng hạn để dể dùng công thức xử lý nó.
Mong các anh chị nào cao tay giúp đỡ.
Cảm ơn nhiều.

 

[giauvn]

 

[phulien1902]

Xin chào các bạn như tiêu đề trên.
Mình có rất nhiều file dạng *.txt bên trong chứa các dòng văn bản gần giống nhau.
Nội dung nó tương đồng vối 5 file mình đính kèm.
Mình muốn lấy chuỗi văn bản trong file text đó từ dòng thứ 31 đến dòng 200 cho nó ra từng dòng trong excel.
Mỗi nội dung văn bản trong file text sẽ cho ra excel liên tiếp các dòng nối đuôi nhau trong 1 cột ví dụ là cột D chẳng hạn để dể dùng công thức xử lý nó.
Mong các anh chị nào cao tay giúp đỡ.
Cảm ơn nhiều.

Bạn thử:

Sub Test()
    Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
    Dim i&, j&, k&, b(1 To 5000, 1 To 15)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    MsgBox "Xin moi chon tat ca cac File Text" & Chr(10)
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "TXT File", "*.txt", 1
        If Not .Show = -1 Then
            MsgBox "Ban da khong chon File nao", vbInformation, "Thông báo"
            Exit Sub
        End If
        On Error Resume Next
        For Each Item In .SelectedItems
            Set TextSource = Fso.OpenTextFile(Item, 1, , -2)
            TotalLines = Split(TextSource.ReadAll, vbCrLf)
            For i = 31 To UBound(TotalLines)
                If Len(TotalLines(i)) Then
                    Tmp = Split(TotalLines(i), " ")
                    k = k + 1
                    b(k, 1) = Fso.GetBaseName(Item)
                    For j = 2 To 15
                        b(k, j) = Tmp(j - 1)
                    Next j
                End If
            Next
        Next
    End With
    If k Then
        Range("A2:O5000").ClearContents
        Range("A2").Resize(k, 15).Value = b
    End If
    MsgBox "Da cap nhat xong"
    ActiveSheet.Range("A1").Select
    Application.ScreenUpdating = True
End Sub

 

[VetMini]

...
Application.ScreenUpdating = False
MsgBox "Xin moi chon tat ca cac File Text" & Chr(10)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "TXT File", "*.txt", 1
If Not .Show = -1 Then
MsgBox "Ban da khong chon File nao", vbInformation, "Thông báo"
Exit Sub
End If
On Error Resume Next
...

1. (đỏ) Exit Sub mất đất rồi ai trả lại bảng tính về trạng thái ban đầu?

2. (xanh) Cứ lướt qua hết Error rồi làm sao biết lúc lấy dữ liệu có gì sai sót?

 

[giauvn]

Bạn thử:

Sub Test()
    Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
    Dim i&, j&, k&, b(1 To 5000, 1 To 15)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    MsgBox "Xin moi chon tat ca cac File Text" & Chr(10)
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "TXT File", "*.txt", 1
        If Not .Show = -1 Then
            MsgBox "Ban da khong chon File nao", vbInformation, "Thông báo"
            Exit Sub
        End If
        On Error Resume Next
        For Each Item In .SelectedItems
            Set TextSource = Fso.OpenTextFile(Item, 1, , -2)
            TotalLines = Split(TextSource.ReadAll, vbCrLf)
            For i = 31 To UBound(TotalLines)
                If Len(TotalLines(i)) Then
                    Tmp = Split(TotalLines(i), " ")
                    k = k + 1
                    b(k, 1) = Fso.GetBaseName(Item)
                    For j = 2 To 15
                        b(k, j) = Tmp(j - 1)
                    Next j
                End If
            Next
        Next
    End With
    If k Then
        Range("A2:O5000").ClearContents
        Range("A2").Resize(k, 15).Value = b
    End If
    MsgBox "Da cap nhat xong"
    ActiveSheet.Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Cảm ơn các bạn đã quan tâm, mình lấy Code của bạn Phuien1902 sửa lại dòng số 18 thành For i = 16 To UBound(TotalLines) thì ra được kết quả text trong Sheet đã chọn sẵn đúng các dòng văn bản theo ý muốn.
Tuy nhiên mình gặp một số vấn đề là các văn bản trong Excel không thể hiện đúng văn bản trong file text chữ bị sai.(Xem ảnh kèm theo)
Và các cột khi nhập vào excel nó lại nhảy lung tung.
Nếu các bạn có thể cho văn bản trong file text ra từng dòng trong excel và nó chỉ nằm duy nhất trong 1 cột thì càng tốt. (Giống như kiểu copy văn bản bên text rồi dán vào 1 cột trong excel)
Cảm ơn các bạn quan tâm.