Nhờ sửa chuyển font chữ trong excel

[hienzukon]

Hi cả nhà,
Mình có file dữ liệu xuất từ hệ thống ra bị lỗi font chữ mà chuyển mã bằng unikey các kiểu vẫn ko được, nhờ các cao thủ xem có cách gì ko ạ. Thanks !
Mình gửi kèm file dưới

 

[HeSanbi]

Bạn xuất dữ liệu ra như thế nào. từ một file text, csv,.. Trực tiếp hay gián tiếp

 

[hienzukon]

Bạn xuất dữ liệu ra như thế nào. từ một file text, csv,.. Trực tiếp hay gián tiếp

Từ 1 file .txt ạ, file gốc không lỗi nhiều vậy đâu

 

[HeSanbi]

Từ 1 file .txt ạ, file gốc không lỗi nhiều vậy đâu

Sao tôi không thấy file đó ở đâu cả. file đấy chứa text của bạn. mà bạn chỉ đưa file ví dụ. Lấy gì test thử đây

 

[hienzukon]

Sao tôi không thấy file đó ở đâu cả. file đấy chứa text của bạn. mà bạn chỉ đưa file ví dụ. Lấy gì test thử đây

Đây nhờ bạn xem giúp nhé

 

[ndu96081631]

Đây nhờ bạn xem giúp nhé

File này bình thường, có lỗi font gì đâu chứ. Import vào Excel ngon lành luôn

 

[HeSanbi]

Nếu lười biến thao tác trên excel thì thử xem có đúng một nốt nhạc không

Sub getDataFromFile()
    Dim arr
' Duong` dan den File
    Const kFile As String = "\xpart_0.txt"
    'getTxT kFile, Sheet1.[A1], "|"
    'neu' dung` getTxT kFile, Sheet1.[A1] thì bo cac' hàng duoi nay` di
    aArr = getTxT(kFile, , "|")
    [A1].Resize(UBound(aArr), UBound(aArr, 2)) = aArr
End Sub


Function getTxT(sFile As String, Optional ByVal rng As Range, Optional ByVal punc As string = " ") As Variant
    Dim objStream, strAdo, arr() As String, dArr() As Variant, xArr() As String
    Dim i As Integer, j As Integer, k As Integer: k = 0
        Set objStream = CreateObject("ADODB.Stream")
        With objStream
            .Type = 2 'Stream type
            .Charset = "utf-8" 'or utf-16 etc
            .Open
            .LoadFromFile sFile
            .LineSeparator = 13
            strAdo = .ReadText(-2)
            .Close
        End With
    arr = Split(strAdo, Chr(10))
    For i = 0 To UBound(arr)
        xArr = Split(Application.WorksheetFunction.Clean(Trim(arr(i))), punc)
        If UBound(xArr) > k Then k = UBound(xArr) + 1
        ReDim Preserve dArr(1 To UBound(arr) + 1, 1 To k)
        For j = 0 To UBound(xArr)
            dArr(i + 1, j + 1) = Application.WorksheetFunction.Clean(Trim(xArr(j)))
        Next j
    Next i
    getTxT = dArr
    Set objStream = Nothing
    If rng Is Nothing Or IsArray(rng) Then Exit Function
        rng.Resize(UBound(dArr), UBound(dArr, 2)) = dArr
End Function