Xử lý các ký tự đặc biệt

[tuhocvba]

Trong khi coi video file phụ đề (.srt) có chứa các ký tự đặc biệt, vì thế khi coi video nó làm cho việc hiển thị tiếng việt có dấu bị sai.

Bạn cần đăng nhập để thấy đính kèm

Các ký tự đặc biệt kiểu này là các ký tự không biết trước.
Do đó tôi mong muốn có một chương trình xử lý file này, tìm các ký tự mà không phải là các chữ cái a,b,c,... và các từ tiếng việt có dấu, hay các số 0, 1,2,3,..., khoảng trắng, dấu tab, :, ., dấu phẩy và loại bỏ nó đi.
Mời các bạn thảo luận và đưa ra giải pháp.

 

[17namvu]

Mình đề xuất ý tưởng như sau:
1. Đọc từng dòng của file srt đó đồng thời gán cho nó một biến đếm
2. Khi đọc chương trình sẽ kiểm tra biến đếm đó. Nếu biến đếm không chia hết cho 3 thì chỉ việc đọc và ghi dòng đó sang file kết quả, ngược lại thì sẽ kiểm tra xem nó có ký tự đặc biệt nào không, nếu có thì loại, xử lý xong sẽ ghi dòng đó vào file kết quả.
Đó mới là ý tưởng thôi, còn bài làm thì phải nghĩ tiếp đã các bác ạ

 

[phuonghong1997]

Các bác admin chắc không còn lạ gì đường lối, nên em đi vào cụ thể. Vấn đề tốn công tốn sức nhất là liệt kê ra các ký tự có nghĩa. Ở đây em đề xuất code sau:

Dim kytuarr()
Sub khoitaomang()
    Dim i As Long, cnt As Long
    Dim sarr, CharCode
    
    sarr = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
                "-", ">", ":", ",", " ", ".", "!", "[", "]", "(", ")", "?", _
                "{", "}", "%", "&", "#", "$", "=", "+", "-", "<", ">", ";", "@", "\", _
                "|", "/")

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
    ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
    ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
    ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
    ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
    ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
    ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    cnt = 0
    For i = LBound(sarr) To UBound(sarr) Step 1
        cnt = cnt + 1
        If cnt = 1 Then
            ReDim kytuarr(1 To cnt)
        Else
            ReDim Preserve kytuarr(1 To cnt)
        End If
        kytuarr(cnt) = sarr(i)
    Next i
    For i = LBound(CharCode) To UBound(CharCode) Step 1
        cnt = cnt + 1
        If cnt = 1 Then
            ReDim kytuarr(1 To cnt)
        Else
            ReDim Preserve kytuarr(1 To cnt)
        End If
        kytuarr(cnt) = CharCode(i)
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = UCase(CharCode(i))
    Next i
    'A->Z, a->z
    For i = 65 To 90 Step 1
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = Chr(i)
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = LCase(Chr(i))
    Next i
    
    'tab
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = vbTab
    
    'Dau xuong dong
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = Chr(10)
    
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = Chr(13)
End Sub

 

[17namvu]

@phuonghong1997 cái này bạn mới chỉ đang làm phần xử lý chuỗi đúng không nhỉ, chứ mình không thấy xử lý phần đầu ra là file srt đã chỉnh sửa

 

[phuonghong1997]

Với năng lực của các bác admin thì cái vấn đề mất công sức là ở cái bước trên thôi bác.
Còn phần sau thì đơn giản lắm.

Sub main()
    Dim lk  As String
    Const ForReading = 1
    
    lk = "D:\VBA\003 Downloadable Resources and Tips for Taking the Course.en_US.vi.srt"

    Call khoitaomang
    Call readfile(lk)
End Sub

Sub createfilesrt(ByVal noidung As String, ByVal lkop As String)
    Dim objStream
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Charset = "utf-8"
    objStream.Open
    objStream.WriteText noidung
    objStream.SaveToFile lkop, 2
End Sub
Sub readfile(ByVal lk As String)
    Dim i   As Long
    Dim buf As String, lkop As String
    Dim Dic As Object
    
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile lk
        buf = .ReadText
        .Close
        
    End With
    
    Set Dic = CreateObject("Scripting.Dictionary")
    
    For i = LBound(kytuarr) To UBound(kytuarr) Step 1
        s = CStr(kytuarr(i))
        If Not Dic.Exists(s) Then
            Dic.Add s, i
        End If
    Next i
    
    
    For i = Len(buf) To 1 Step -1
        s = Mid(buf, i, 1)
        
        If Not Dic.Exists(s) Then
            buf = Replace(buf, s, "", , , vbTextCompare)
        End If
    Next i
    lkop = creatlinkop(lk)
    Call createfilesrt(buf, lkop)
End Sub
'Input: C:\Users\admin\Desktop\test.txt
'Output: C:\Users\admin\Desktop\test2.txt
Function creatlinkop(ByVal lk As String) As String
    Dim lkl As String, lkr  As String
    Dim i   As Long
    i = InStrRev(lk, ".", , vbTextCompare)
    lkl = Left(lk, i - 1)
    lkr = Right(lk, Len(lk) - i + 1)
    creatlinkop = lkl & "2" & lkr
End Function

Kết quả:
Trước khi chạy code:

Bạn cần đăng nhập để thấy hình ảnh

Sau khi chạy code:

Bạn cần đăng nhập để thấy hình ảnh

 

[tuhocvba]

Quả là kỳ công, tuy nhiên mảng sarr có thể viết đầy đủ lại như sau:

Bạn cần đăng nhập để thấy đính kèm

Chú ý: 0-9, a-z có mã ascii liên tiếp nên có thể nạp trực tiếp bằng lệnh For.

Dim kytuarr()
Sub khoitaomang()
    Dim i As Long, cnt As Long
    Dim sarr, CharCode
    
    sarr = Array(Chr(33), Chr(34), Chr(35), Chr(36), Chr(37), Chr(38), Chr(39), Chr(40), _
        Chr(41), Chr(61), Chr(45), Chr(126), Chr(94), Chr(92), Chr(124), _
        Chr(64), Chr(96), Chr(123), Chr(91), Chr(125), Chr(93), Chr(42), _
        Chr(58), Chr(43), Chr(59), Chr(95), Chr(63), Chr(47), Chr(62), _
        Chr(46), Chr(60), Chr(44))

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
    ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
    ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
    ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
    ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
    ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
    ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    cnt = 0
    For i = LBound(sarr) To UBound(sarr) Step 1
        cnt = cnt + 1
        If cnt = 1 Then
            ReDim kytuarr(1 To cnt)
        Else
            ReDim Preserve kytuarr(1 To cnt)
        End If
        kytuarr(cnt) = sarr(i)
    Next i
    For i = LBound(CharCode) To UBound(CharCode) Step 1
        cnt = cnt + 1
        If cnt = 1 Then
            ReDim kytuarr(1 To cnt)
        Else
            ReDim Preserve kytuarr(1 To cnt)
        End If
        kytuarr(cnt) = CharCode(i)
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = UCase(CharCode(i))
    Next i
    'A->Z, a->z
    For i = 65 To 90 Step 1
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = Chr(i)
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = LCase(Chr(i))
    Next i
    '0-9
    For i = 48 To 57 Step 1
        cnt = cnt + 1
        ReDim Preserve kytuarr(1 To cnt)
        kytuarr(cnt) = Chr(i)
    Next i
    'tab
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = vbTab
    
    'Dau xuong dong
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = Chr(10)
    
    cnt = cnt + 1
    ReDim Preserve kytuarr(1 To cnt)
    kytuarr(cnt) = Chr(13)
End Sub