Đọc chuỗi Unicode từ file txt

Liên hệ QC
B

Bluestar092011

Thành viên hoạt động
Tham gia
17/8/15
Bài viết
129
Được thích
147
Giới tính
Nam
Tôi có dùng code sau để lấy dữ liệu từ file TXT để đưa vào Excel, nhưng trong file TXT lại có chuỗi Unicode khi đọc sang Excel bị lại bị mã hết. Nhờ các thành viên ai từng gặp trường hợp này hướng dẫn tôi khắc phục với. (Một lưu ý là file TXT này được tạo ra từ ứng dụng Arduino Nano ghi dữ liệu vào thẻ SD)
Mã: 
Sub OpenTextFile()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, k%, stex, i%
    Set txtFile = FSo.OpenTextFile(ThisWorkbook.Path & "\06042021.txt", 1, False, -2)
    stex = Split(txtFile.ReadAll, vbCrLf)
    k = 1
    For i = LBound(stex) To UBound(stex)
        k = k + 1
        'Cho nay la tach du lieu ra cac cot
        Range("A" & k) = stex(i)
    Next
    txtFile.Close
    Set txtFile = Nothing
    Set FSo = Nothing
End Sub
 

File đính kèm

  • ReadText.zip
    14.5 KB · Đọc: 10
Bluestar092011 đã viết:
Tôi có dùng code sau để lấy dữ liệu từ file TXT để đưa vào Excel, nhưng trong file TXT lại có chuỗi Unicode khi đọc sang Excel bị lại bị mã hết. Nhờ các thành viên ai từng gặp trường hợp này hướng dẫn tôi khắc phục với. (Một lưu ý là file TXT này được tạo ra từ ứng dụng Arduino Nano ghi dữ liệu vào thẻ SD)
Mã: 
Sub OpenTextFile()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, k%, stex, i%
    Set txtFile = FSo.OpenTextFile(ThisWorkbook.Path & "\06042021.txt", 1, False, -2)
    stex = Split(txtFile.ReadAll, vbCrLf)
    k = 1
    For i = LBound(stex) To UBound(stex)
        k = k + 1
        'Cho nay la tach du lieu ra cac cot
        Range("A" & k) = stex(i)
    Next
    txtFile.Close
    Set txtFile = Nothing
    Set FSo = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn cần 1 hàm convert mã UTF-8 sang unicode
PHP: 
Sub OpenTextFile()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, k%, stex, i%
    Set txtFile = FSo.OpenTextFile(ThisWorkbook.Path & "\06042021.txt", 1, False, -2)
    stex = Split(txtFile.ReadAll, vbCrLf)
    k = 1
    For i = LBound(stex) To UBound(stex)
        k = k + 1
        'Cho nay la tach du lieu ra cac cot
        Range("A" & k) = UTF8_Decode(stex(i))
    Next
    txtFile.Close
    Set txtFile = Nothing
    Set FSo = Nothing
End Sub
''' WinApi function that maps a UTF-16 (wide character) string to a new character string
Function UTF8_Decode(ByVal sStr)
    Dim l As Long, sUTF8 As String, iChar As Integer, iChar2 As Integer
    For l = 1 To Len(sStr)
        iChar = Asc(Mid(sStr, l, 1))
        If iChar > 127 Then
            If Not iChar And 32 Then ' 2 chars
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            sUTF8 = sUTF8 & ChrW$(((31 And iChar) * 64 + (63 And iChar2)))
            l = l + 1
        Else
            Dim iChar3 As Integer
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            iChar3 = Asc(Mid(sStr, l + 2, 1))
            sUTF8 = sUTF8 & ChrW$(((iChar And 15) * 16 * 256) + ((iChar2 And 63) * 64) + (iChar3 And 63))
            l = l + 2
        End If
            Else
            sUTF8 = sUTF8 & Chr$(iChar)
        End If
    Next l
    UTF8_Decode = sUTF8
End Function
 [\php]
 
vu_tuan_manh_linh đã viết:
Bạn cần 1 hàm convert mã UTF-8 sang unicode
PHP: 
Sub OpenTextFile()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, k%, stex, i%
    Set txtFile = FSo.OpenTextFile(ThisWorkbook.Path & "\06042021.txt", 1, False, -2)
    stex = Split(txtFile.ReadAll, vbCrLf)
    k = 1
    For i = LBound(stex) To UBound(stex)
        k = k + 1
        'Cho nay la tach du lieu ra cac cot
        Range("A" & k) = UTF8_Decode(stex(i))
    Next
    txtFile.Close
    Set txtFile = Nothing
    Set FSo = Nothing
End Sub
''' WinApi function that maps a UTF-16 (wide character) string to a new character string
Function UTF8_Decode(ByVal sStr)
    Dim l As Long, sUTF8 As String, iChar As Integer, iChar2 As Integer
    For l = 1 To Len(sStr)
        iChar = Asc(Mid(sStr, l, 1))
        If iChar > 127 Then
            If Not iChar And 32 Then ' 2 chars
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            sUTF8 = sUTF8 & ChrW$(((31 And iChar) * 64 + (63 And iChar2)))
            l = l + 1
        Else
            Dim iChar3 As Integer
            iChar2 = Asc(Mid(sStr, l + 1, 1))
            iChar3 = Asc(Mid(sStr, l + 2, 1))
            sUTF8 = sUTF8 & ChrW$(((iChar And 15) * 16 * 256) + ((iChar2 And 63) * 64) + (iChar3 And 63))
            l = l + 2
        End If
            Else
            sUTF8 = sUTF8 & Chr$(iChar)
        End If
    Next l
    UTF8_Decode = sUTF8
End Function
[\php]
Nhấp chuột vào đây để mở rộng...
Đúng cái tôi cần rồi ạ, cảm ơn bạn nhiều.
 
Vầy cho đơn giản

PHP: 
Sub vidu()
    Dim p As String
    p = "C:\Users\Administrator\Desktop\06042021.TXT"
    Range("A11").Value = readText(p)
End Sub
'
Function readText(ByVal strFile As String) As String
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    With fileStream
        .Charset = "utf-8"
        .Type = 2
        .Open
        .LoadFromFile strFile
        readText = .readText()
        .Close
    End With
    Set fileStream = Nothing
End Function
 
befaint đã viết:
Vầy cho đơn giản

PHP: 
Sub vidu()
    Dim p As String
    p = "C:\Users\Administrator\Desktop\06042021.TXT"
    Range("A11").Value = readText(p)
End Sub
'
Function readText(ByVal strFile As String) As String
    Dim fileStream As Object
    Set fileStream = CreateObject("ADODB.Stream")
    With fileStream
        .Charset = "utf-8"
        .Type = 2
        .Open
        .LoadFromFile strFile
        readText = .readText()
        .Close
    End With
    Set fileStream = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Bị đụng hàng :D

Mã: 
Sub LayDL()
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Open
        .LoadFromFile (ThisWorkbook.Path & "\06042021.TXT")
        Range("A2") = .readText()
    End With
End Sub
 
Các anh cho hỏi thêm, theo cách của @befaint và @Hai Lúa Miền Tây thì nếu dữ liệu cỡ 200 hàng thì dữ liệu có lấy hết 1 lần không ạ? (Vì dùng đt nên chưa test thử).
 
Tiện thể tách luôn các ký tự ra cho vào mảng luôn vậy
PHP: 
Sub LayDL()
Dim stex, stex1, i, k
With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Open
    .LoadFromFile (ThisWorkbook.Path & "\06042021.TXT")
    stex = Split(.readText(), vbCrLf)
End With
For i = 0 To UBound(stex)
    stex1 = Split(stex(i), "|")
    For k = 0 To UBound(stex1)
    'Cho nay la tach du lieu ra cac cot
        Cells(i + 2, k + 1).Value = stex1(k)
    Next
Next
End Sub
 
VetMini đã viết:
Tôi cứ tưởng cớ trình đọ bạn thì người ta chỉ cần mách 1 tí, tự mò mẫm ra chỗ còn lại.
Té ra cũng muốn nhận hàng từ a đến z hở.
Nhấp chuột vào đây để mở rộng...
Không phải đâu anh, định hỏi cho biết khả năng áp dụng thực tế thôi, chứ test thử 200 hay 500 thì mất 1 phút tạo dữ liệu và test thôi. Cái em cần biết là giới hạn thực tế số hàng có thể áp dụng (chẳng lẻ ngồi mò 1000 hàng, rồi 900 hàng, rồi 800 hàng...) chỉ 1 cái kết là áp dụng được bao nhiêu hàng là em đỡ ngồi mò có khi cả ngay.
Bài đã được tự động gộp:

vu_tuan_manh_linh đã viết:
Tiện thể tách luôn các ký tự ra cho vào mảng luôn vậy
PHP: 
Sub LayDL()
Dim stex, stex1, i, k
With CreateObject("ADODB.Stream")
    .Charset = "utf-8"
    .Open
    .LoadFromFile (ThisWorkbook.Path & "\06042021.TXT")
    stex = Split(.readText(), vbCrLf)
End With
For i = 0 To UBound(stex)
    stex1 = Split(stex(i), "|")
    For k = 0 To UBound(stex1)
    'Cho nay la tach du lieu ra cac cot
        Cells(i + 2, k + 1).Value = stex1(k)
    Next
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh vụ tách thì em làm được rồi, chỉ có cái vướng unicode thôi. Tôi nghĩ tách vào ô chủ cần 1 vòng for thôi là đủ rồi.
 
Lần chỉnh sửa cuối:
File txt của bạn phải tính bằng mê chứ sao lại tính dòng hihi
 
thuyyeu99 đã viết:
File txt của bạn phải tính bằng mê chứ sao lại tính dòng hihi
Nhấp chuột vào đây để mở rộng...
Mình sẽ đọc hết dữ liệu trong file, chỉ tại code ở #4 và #5 đưa dữ liệu vào 1 ô và vào biến kiểu string nên mới nghi ngờ là nó sẽ không chứa nỗi trong kiểu string nếu dữ liệu 200 hàng.
 
Bluestar092011 đã viết:
Mình sẽ đọc hết dữ liệu trong file, chỉ tại code ở #4 và #5 đưa dữ liệu vào 1 ô và vào biến kiểu string nên mới nghi ngờ là nó sẽ không chứa nỗi trong kiểu string nếu dữ liệu 200 hàng.
Nhấp chuột vào đây để mở rộng...
Cái này nó lại liên quan đến max ký tự trong 1 cell của excel
 
Tức bạn là người trong danh sách "bè lũ bốn tên (gang of four)" hay bạn chỉ dùng nít mà không biết mình từng bị gì?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

D
Định dạng trong excel làm nghiệm thu đường
Trả lời
19
Đọc
13K
Hoàng Tuấn 868
H
Kiều Mạnh
Mã nguồn Add-Ins *.xll trên Delphi cho Excel
    • Thích
    • Cảm ơn
2
Trả lời
39
Đọc
4K
vu_tuan_manh_linh
vu_tuan_manh_linh
V
Giúp công thức cộng tổng cột SỐ lượng theo cột STT nếu trùng lấy dòng nằm trên
Trả lời
17
Đọc
645
CHAOQUAY
C
zhouding
xin hướng dẫn cộng các ô gộp excel. ( không sử dụng format painter)
Trả lời
7
Đọc
78
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
L
[xin nhờ giúp đỡ] hàm trích xuất ra dữ liệu thỏa mã điều kiện và ghi vào một ô
Trả lời
10
Đọc
410
cantl
C
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom