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

giauvn

Thành viên mới
Tham gia ngày
25 Tháng tư 2017
Bài viết
6
Được thích
0
Điểm
163
Tuổi
37
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.
 

File đính kèm

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,406
Được thích
4,220
Điểm
560
Nơi ở
Hải Phòng
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ử:
PHP:
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

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,708
Được thích
9,050
Điểm
560
...
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

Thành viên mới
Tham gia ngày
25 Tháng tư 2017
Bài viết
6
Được thích
0
Điểm
163
Tuổi
37
Bạn thử:
PHP:
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.
 

File đính kèm

Top Bottom