Lấy và tách dữ liệu từ file .txt mà không cần mở file txt

kechuong · 3/7/22

Em có nghiên cứu 1 đoạn code trên nhóm giảiphápexcel nhưng vì không có điều kiện đi học mở rỗng thêm, mong các anh chị trong nhóm giúp đỡ em thêm ạ !
Em có 1 file excel ( để ở ngoài desktop) và 1 file txt có tên là " vi-du.txt " ( để ở ngoài desktop) em muốn :
bước 1 > lấy dữ liệu của file vi-du.txt ( không cần mở file vi-du.txt ) lên sheet1 cột A của file excel ( để em xử lý dữ liệu )
bước 2 > lấy dữ liệu ngược lại từ sheet1 Cột A của file excel ra 1 file .txt mới có tên là " kết-quả.txt " ngoài desktop
hy vọng nhận được sự giúp đỡ của các anh chị trong nhóm ! em xin cám ơn ạ !

kechuong · 3/7/22

anh chị trong nhóm giúp em với ạ ! :.,

batman1 · 3/7/22

kechuong đã viết:
anh chị trong nhóm giúp em với ạ !

Muốn người ta giúp thì chịu khó mô tả cụ thể, kỹ lưỡng.

Theo tôi hiểu thì đã có code đọc dữ liệu từ tập tin TXT, nhưng bây giờ không chơi trò mở cửa sổ chọn tập tin nữa mà luôn luôn đọc từ tập tin đã biết tên là "vi-du.txt" nằm trong cùng thư mục với tập tin Excel có code.

Và nữa.

bước 2 > lấy dữ liệu ngược lại từ sheet1 Cột A của file excel ra 1 file .txt mới có tên là " kết-quả.txt " ngoài desktop

Rõ ràng là ở bước 1 dữ liệu đọc vào được ghi ở B1 (trong A1 là tên tập tin). Như vậy thì ở bước 2 là lấy dữ liệu để ghi từ A1 hay B1? Cẩu thả quá.

Tôi cho rằng sau khi chỉnh sửa ở B1 thì lấy dữ liệu ở B1 ghi ra "ket-qua.txt"

vi-du.txt dùng encoding = utf-8. Vậy ket-qua.txt cũg phải dùng encoding = utf-8?

Nếu các câu trả lời là ĐÚNG THẾ thì

Mã:

Sub doc_vao()
Dim filename As String
    filename = "vi-du.txt"
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Type = 2
        .Open
        .LoadFromFile ThisWorkbook.Path & "\" & filename
        .LineSeparator = 10
        If Not .EOS Then
            Sheet1.Range("A1").Value = filename
            Sheet1.Range("B1").Value = .ReadText(-1)
        End If
        .Close
    End With
End Sub

Sub ghi_ra()
Dim filename As String, text As String
    filename = "ket-qua.txt"
    text = Sheet1.Range("B1").Value
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText text
        .SaveToFile ThisWorkbook.Path & "\" & filename, 2
        .Close
    End With
End Sub

kechuong · 3/7/22

batman1 đã viết:
Muốn người ta giúp thì chịu khó mô tả cụ thể, kỹ lưỡng.

Theo tôi hiểu thì đã có code đọc dữ liệu từ tập tin TXT, nhưng bây giờ không chơi trò mở cửa sổ chọn tập tin nữa mà luôn luôn đọc từ tập tin đã biết tên là "vi-du.txt" nằm trong cùng thư mục với tập tin Excel có code.

Và nữa.

Rõ ràng là ở bước 1 dữ liệu đọc vào được ghi ở B1 (trong A1 là tên tập tin). Như vậy thì ở bước 2 là lấy dữ liệu để ghi từ A1 hay B1? Cẩu thả quá.

Tôi cho rằng sau khi chỉnh sửa ở B1 thì lấy dữ liệu ở B1 ghi ra "ket-qua.txt"

vi-du.txt dùng encoding = utf-8. Vậy ket-qua.txt cũg phải dùng encoding = utf-8?

Nếu các câu trả lời là ĐÚNG THẾ thì

Mã:

Sub doc_vao() Dim filename As String filename = "vi-du.txt" With CreateObject("ADODB.Stream") .Charset = "utf-8" .Type = 2 .Open .LoadFromFile ThisWorkbook.Path & "\" & filename .LineSeparator = 10 If Not .EOS Then Sheet1.Range("A1").Value = filename Sheet1.Range("B1").Value = .ReadText(-1) End If .Close End With End Sub Sub ghi_ra() Dim filename As String, text As String filename = "ket-qua.txt" text = Sheet1.Range("B1").Value With CreateObject("ADODB.Stream") .Type = 2 .Charset = "utf-8" .Open .WriteText text .SaveToFile ThisWorkbook.Path & "\" & filename, 2 .Close End With End Sub

Dạ anh ! em cám ơn anh ! anh giúp em cái này nữa nha !
Sub doc_vao() : thay vì nguyên cụm ở B1 thì em muốn cho xuống từng hàng !
Sub ghi_ra() : thay vì ghi ra B1 thì em muốn cho ghi ra nguyên 1 cột B luôn ạ !
em có kèm theo hình ảnh ! hy vọng anh giúp em cái này nữa !

batman1 · 4/7/22

kechuong đã viết:
Dạ anh ! em cám ơn anh ! anh giúp em cái này nữa nha !
Sub doc_vao() : thay vì nguyên cụm ở B1 thì em muốn cho xuống từng hàng !
Sub ghi_ra() : thay vì ghi ra B1 thì em muốn cho ghi ra nguyên 1 cột B luôn ạ !
em có kèm theo hình ảnh ! hy vọng anh giúp em cái này nữa !

Do bạn không nói, kết quả mới thêm tiếp vào sau kết quả cũ hay thay thế nên tôi làm thêm sau kết quả cũ. Nếu là thay thế thì tự xóa kết quả cũ trước khi chạy code. Và nhớ là lần sau phải nói rõ mới có được theo yêu cầu.

Nếu chưa có kết quả cũ thì kết quả mới cũng nhập vào từ B2 trở đi. Khi ghi ra thì cũng chỉ xét dữ liệu ở cột B từ dòng 2 trở đi. B1 có thể dùng làm tiêu đề.

Mã:

Sub doc_vao()
Dim lastRow As Long, k As Long, filename As String, dulieu
    filename = "vi-du.txt"
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Type = 2
        .Open
        .LoadFromFile ThisWorkbook.Path & "\" & filename
        If Not .EOS Then
            dulieu = Split(.ReadText, vbCrLf)
            With Sheet1
                lastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & lastRow).Value = filename
                For k = 0 To UBound(dulieu)
                    Sheet1.Range("B" & lastRow + k).Value = dulieu(k)
                Next k
            End With
        End If
        .Close
    End With
End Sub

Sub ghi_ra()
Dim lastRow As Long, k As Long, filename As String, text As String, dulieu()
    filename = "ket-qua.txt"
    With Sheet1
        lastRow = .Range("B" & Rows.Count).End(xlUp).Row    ' dong cuoi cung co du lieu o cot B
        If lastRow < 2 Then Exit Sub
        dulieu = .Range("B2:B" & lastRow + 1).Value ' lay du 1 dong cuoi
    End With
    text = dulieu(1, 1)
    For k = 2 To UBound(dulieu, 1) - 1  ' khong xet dong lay du
        text = text & vbCrLf & dulieu(k, 1)
    Next k
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText text
        .SaveToFile ThisWorkbook.Path & "\" & filename, 2
        .Close
    End With
End Sub

kechuong · 4/7/22

batman1 đã viết:
Do bạn không nói, kết quả mới thêm tiếp vào sau kết quả cũ hay thay thế nên tôi làm thêm sau kết quả cũ. Nếu là thay thế thì tự xóa kết quả cũ trước khi chạy code. Và nhớ là lần sau phải nói rõ mới có được theo yêu cầu.

Nếu chưa có kết quả cũ thì kết quả mới cũng nhập vào từ B2 trở đi. Khi ghi ra thì cũng chỉ xét dữ liệu ở cột B từ dòng 2 trở đi. B1 có thể dùng làm tiêu đề.

Mã:

Sub doc_vao() Dim lastRow As Long, k As Long, filename As String, dulieu filename = "vi-du.txt" With CreateObject("ADODB.Stream") .Charset = "utf-8" .Type = 2 .Open .LoadFromFile ThisWorkbook.Path & "\" & filename If Not .EOS Then dulieu = Split(.ReadText, vbCrLf) With Sheet1 lastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("A" & lastRow).Value = filename For k = 0 To UBound(dulieu) Sheet1.Range("B" & lastRow + k).Value = dulieu(k) Next k End With End If .Close End With End Sub Sub ghi_ra() Dim lastRow As Long, k As Long, filename As String, text As String, dulieu() filename = "ket-qua.txt" With Sheet1 lastRow = .Range("B" & Rows.Count).End(xlUp).Row ' dong cuoi cung co du lieu o cot B If lastRow < 2 Then Exit Sub dulieu = .Range("B2:B" & lastRow + 1).Value ' lay du 1 dong cuoi End With text = dulieu(1, 1) For k = 2 To UBound(dulieu, 1) - 1 ' khong xet dong lay du text = text & vbCrLf & dulieu(k, 1) Next k With CreateObject("ADODB.Stream") .Type = 2 .Charset = "utf-8" .Open .WriteText text .SaveToFile ThisWorkbook.Path & "\" & filename, 2 .Close End With End Sub

dạ ! em làm được rồi ! em cám ơn anh thật nhiều nha ! chúc anh và gia đình có thật nhiều sức khỏe anh nhé ! /-*+/

Feeling_nothing · 4/7/22

batman1 đã viết:
Do bạn không nói, kết quả mới thêm tiếp vào sau kết quả cũ hay thay thế nên tôi làm thêm sau kết quả cũ. Nếu là thay thế thì tự xóa kết quả cũ trước khi chạy code. Và nhớ là lần sau phải nói rõ mới có được theo yêu cầu.

Nếu chưa có kết quả cũ thì kết quả mới cũng nhập vào từ B2 trở đi. Khi ghi ra thì cũng chỉ xét dữ liệu ở cột B từ dòng 2 trở đi. B1 có thể dùng làm tiêu đề.

Mã:

Sub doc_vao() Dim lastRow As Long, k As Long, filename As String, dulieu filename = "vi-du.txt" With CreateObject("ADODB.Stream") .Charset = "utf-8" .Type = 2 .Open .LoadFromFile ThisWorkbook.Path & "\" & filename If Not .EOS Then dulieu = Split(.ReadText, vbCrLf) With Sheet1 lastRow = .Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("A" & lastRow).Value = filename For k = 0 To UBound(dulieu) Sheet1.Range("B" & lastRow + k).Value = dulieu(k) Next k End With End If .Close End With End Sub Sub ghi_ra() Dim lastRow As Long, k As Long, filename As String, text As String, dulieu() filename = "ket-qua.txt" With Sheet1 lastRow = .Range("B" & Rows.Count).End(xlUp).Row ' dong cuoi cung co du lieu o cot B If lastRow < 2 Then Exit Sub dulieu = .Range("B2:B" & lastRow + 1).Value ' lay du 1 dong cuoi End With text = dulieu(1, 1) For k = 2 To UBound(dulieu, 1) - 1 ' khong xet dong lay du text = text & vbCrLf & dulieu(k, 1) Next k With CreateObject("ADODB.Stream") .Type = 2 .Charset = "utf-8" .Open .WriteText text .SaveToFile ThisWorkbook.Path & "\" & filename, 2 .Close End With End Sub

Bạn ơi cũng là bài nay nhưng mình muốn khi chạy code nó sẽ paste thêm dữ liệu vào file txt chứ không phải repalace lại dữ liệu được không ban. Bạn giúp mình với

Lấy và tách dữ liệu từ file .txt mà không cần mở file txt

kechuong

Thành viên mới

File đính kèm

kechuong

Thành viên mới

batman1

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

kechuong

Thành viên mới

File đính kèm

batman1

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

kechuong

Thành viên mới

Feeling_nothing

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng