[Tool Ex Test]Quản lý file Tex bằng VBA từ đó tạo ra đề thi trắc nghiệm tự động

NhanSu

SMod
Thành viên BQT
@tuhocvba đúng là thừa 1 đáp án, vẫn code cũ của mình ở bài 41, sửa dòng 37:
Mã:
Do While CountAns <= slda And i <= n
thành
Mã:
Do While CountAns < slda And i <= n
 

Euler

Administrator
Thành viên BQT
1. Code #41 vẫn có chỗ có thể cải thiện. Nếu tìm không thấy từ khóa \choice thì thoát, không làm việc làm gì nữa.
2. Về cơ bản thuật toán không có gì khác với các cách nghĩ ad đã trình bày trong topic này, nhưng kỹ thuật xử lý có khác.
Thuật toán vẫn là đếm dấu { và }. Vì nội dung văn bản có quá nhiều dấu này, nên cần dò tìm liên tục bằng hàm Instr. Cần thay đổi vị trí bắt đầu tìm kiếm cho hàm Instr, do đó Do ~ Loop đã thực hiện liên tục việc tìm kiếm cho tới khi k = 0 (số lượng dấu { = số lượng dấu } ).
3. Ở bước tiếp theo, tôi rất tâm đắc với việc bạn tìm ra quy luật (để nhìn rõ, tôi sử dụng dấu cách, thực tế là chỉ có { và }:
Mã:
 { { } } { } { }
Code của ad có một hạn chế là tách ra từng dòng để xử lý. Việc này chỉ phù hợp cho việc dọn dẹp rác trước khi vào xử lý chính. Vì đã tách ra từng dòng nên việc đếm ký tự, vòng lặp cũng xử lý khó khăn hơn. Có lẽ ngay từ đầu đã không nắm được các trường hợp có thể xảy ra trong Latex. Trong topic ad cũng liên tục tưởng tượng ra các tình huống và tự mình giải quyết, nếu như tìm hiểu cho kỹ các tình huống rồi mới bắt tay vào code thì sẽ đơn giản hơn.

Vì code #41 cũng đã hay rồi, nên tôi không đưa code của mình lên nữa. Để thuận tiện cho mọi người theo dõi, tôi đưa ra những hình ảnh phân tích, mục đích để mọi người nhìn vào code #41 thấy dễ hiểu hơn.
Bạn cần đăng nhập để thấy đính kèm
 

NhanSu

SMod
Thành viên BQT
Cảm ơn @Euler , mình sửa lại code như sau:
Mã:
Function Tach(ByVal s As String, Optional ByVal slda As Integer = 4)
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
    Const loigiai As String = "\loigiai"
    Dim da, CountAns&, s1$
    Dim StartSearchingPos&, k&, n&, i&, j&, PrevI&
   
    Static RegExp As Object
   
    Tach = s
    If InStr(s, Key) = 0 Then Exit Function
    StartSearchingPos = InStr(s, Key) + Len(Key)
    If InStr(s, loigiai) > 0 Then
        n = InStr(s, loigiai) - 1
    Else
        n = Len(s)
    End If
    s1 = Mid(s, StartSearchingPos, n - StartSearchingPos + 1)
   
   
    If RegExp Is Nothing Then
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp .Global = True
        RegExp .Pattern = "[^{}]"
    End If
    s1 = RegExp.Replace(s1, "")
    n = Len(s1)
   
    i = 1
    PrevI = 1
   
    CountAns = 0
    da = s
    Do While CountAns < slda And i <= n
        If Mid(s1, i, 1) = c2 Then Exit Do
       
        k = 1
        i = i + 1
        Do While k > 0 And i <= n
            If Mid(s1, i, 1) = c2 Then
                k = k - 1
            Else
                k = k + 1
            End If
            i = i + 1
        Loop
        If k > 0 Then Exit Do
        CountAns = CountAns + 1
        If CountAns = 1 Then
            ReDim da(1 To 3, 1 To CountAns)
        Else
            ReDim Preserve da(1 To 3, 1 To CountAns)
        End If
       
        da(2, CountAns) = InStr(StartSearchingPos, s, c1)
        For j = 1 To (i - PrevI) / 2
            StartSearchingPos = InStr(StartSearchingPos, s, c2) + 1
        Next
        da(3, CountAns) = StartSearchingPos - 1
        da(1, CountAns) = Mid(s, da(2, CountAns), StartSearchingPos - da(2, CountAns))
        PrevI = i
    Loop
    Tach = da
End Function
Trong code này mình khai báo biến đối tượng Regexp là static để tránh việc khởi tạo đối tượng nhiều lần, đưa các thuộc tính chỉ gán 1 lần (Global, Pattern) vào khối lệnh kiểm tra regexp đã tồn tại chưa để tăng tốc độ. Các lần gọi hàm Tach từ lần 2 trở đi không cần khởi tạo đối tượng nữa.
Trong hình vẽ ở bài 43 của @Euler thì biến PrevI của mình ở đây là vị trí của "{" bắt đầu của đáp án, đầu tiên i=PrevI, mỗi vòng lặp ta tăng i lên 1 đến khi k=0, lúc này số "{" và "}" bằng nhau và i là vị trí kết thúc đáp án, sau vòng lặp thì i được tăng 1 nên số dấu "}' = (i-prveI)/2. Cả i và prevI đều là vị trí ký tự trên chuỗi s1, có lẽ đặt tên PrevI không hợp lý lắm, đặt là BeginCurrentAnswer thì rõ hơn.
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Chỗ này nếu mà số lượng đáp án lấy ra không đủ thì phải gán Tach = s. Ví dụ:
Mã:
\begin{ex}
Gọi $z_1,z_2$ là nghiệm của phương trình $z^2+2z+3=0$. Giá trị của biểu thức $\left| z_1 \right|^2+\left| z_2 \right|^2$ bằng
\choice
{$2$}
{$\sqrt3$}
{\True $6$}
\loigiai{
}
\end{ex}
Số lượng đáp án đang được quy định là 4 mà chỉ nhặt ra được ít hơn 4 là phải gán Tach = s.
 

NhanSu

SMod
Thành viên BQT
Mình lại tưởng slda là số lượng tối đa. Để tìm đúng số lượng đáp án thì sửa dòng 66 bài 45 thành:
Mã:
If countans=slda then tach=da
Ở dòng 12 đã gán Tach = s rồi nên lệnh trên không cần Else nữa.
 

tuhocvba

Administrator
Thành viên BQT
Code thế này cho ăn chắc:
Mã:
Function tachlayloigiai(ByRef s As String, Optional ByVal slda As Integer = 4)
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
    Const loigiai As String = "\loigiai"
    Dim da, CountAns&, s1$
    Dim StartSearchingPos&, k&, n&, i&, j&, PrevI&
    Const THAYTHEPHANTRAM   As String = "@~"
    Const KYTUGAYNHIEU          As String = "\%"
  
    Static RegExp As Object
    
    On Error GoTo thoat
    tachlayloigiai = s
    Call chuanhoacauhoi(s) 'Loai bo comment %...
    
    If InStr(s, Key) = 0 Then Exit Function
    StartSearchingPos = InStr(s, Key) + Len(Key)
    If InStr(s, loigiai) > 0 Then
        n = InStr(s, loigiai) - 1
    Else
        n = Len(s)
    End If
    s1 = Mid(s, StartSearchingPos, n - StartSearchingPos + 1)
  
  
    If RegExp Is Nothing Then
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.Global = True
        RegExp.Pattern = "[^{}]"
    End If
    s1 = RegExp.Replace(s1, "")
    n = Len(s1)
  
    i = 1
    PrevI = 1
  
    CountAns = 0
    da = s
    Do While CountAns < slda And i <= n
        If Mid(s1, i, 1) = c2 Then Exit Do
      
        k = 1
        i = i + 1
        Do While k > 0 And i <= n
            If Mid(s1, i, 1) = c2 Then
                k = k - 1
            Else
                k = k + 1
            End If
            i = i + 1
        Loop
        If k > 0 Then Exit Do
        CountAns = CountAns + 1
        If CountAns = 1 Then
            ReDim da(1 To 3, 1 To CountAns)
        Else
            ReDim Preserve da(1 To 3, 1 To CountAns)
        End If
      
        da(2, CountAns) = InStr(StartSearchingPos, s, c1)
        For j = 1 To (i - PrevI) / 2
            StartSearchingPos = InStr(StartSearchingPos, s, c2) + 1
        Next
        da(3, CountAns) = StartSearchingPos - 1
        da(1, CountAns) = Mid(s, da(2, CountAns), StartSearchingPos - da(2, CountAns))
        PrevI = i
    Loop
    s = Replace(s, THAYTHEPHANTRAM, KYTUGAYNHIEU, , , vbTextCompare) 'Tra ve ky tu ban dau @~  => \%
    If IsNumeric(CStr(da(2, CountAns))) = False Or IsNumeric(CStr(da(3, CountAns))) = False Then
        tachlayloigiai = s
        Exit Function
    End If
    If CountAns = slda Then
        For i = LBound(da, 2) To UBound(da, 2) Step 1
            da(1, i) = Replace(CStr(da(1, i)), THAYTHEPHANTRAM, KYTUGAYNHIEU, , , vbTextCompare)
        Next i
        tachlayloigiai = da
    End If
thoat:

End Function
Mã:
'Loai bo comment.
'\% => @~
Sub chuanhoacauhoi(ByRef s As String)
    Dim i   As Long
    Dim arr
    Dim stemp   As String
    Dim optemp  As String
    Dim vt      As Long
    Const cm    As String = "%"
    Const THAYTHEPHANTRAM   As String = "@~"
    Const KYTUGAYNHIEU          As String = "\%"
    
    If s = "" Then Exit Sub
    s = Replace(s, KYTUGAYNHIEU, THAYTHEPHANTRAM, , , vbTextCompare)
    arr = Split(s, Chr(10))
    
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        stemp = CStr(arr(i))
        If stemp = "" Then GoTo tiep
        vt = InStr(1, stemp, cm, vbTextCompare)
        If vt > 0 Then
            stemp = Left(stemp, vt - 1)
        End If
        optemp = optemp & Chr(10) & stemp
tiep:
    Next i
    If optemp <> "" Then
        s = optemp
    Else
        vt = InStr(1, s, cm, vbTextCompare)
        If vt > 0 Then
            s = Left(s, vt - 1)
        End If
    End If
End Sub
 

tuhocvba

Administrator
Thành viên BQT
@NhanSu đã phát hành Tool 1.2.6, check facebook, đã tag tên đó. Coi video để thấy hình ảnh của bạn ở trong đó nha. tks.
 

tuhocvba

Administrator
Thành viên BQT
Convert ID Word (Replace trực tiếp trong s nguồn), Xử lý cả ID của BT Pro
Mã:
'\d: so
'\d{1,2}: so co 1 chu so hoac 2 chu so
'\w :A-Z
'[1D3-2.4-3]: ??i s? 11 ch??ng 3. bai 2. d?ng 4. m?c ?? 3 h?
'1D3K2-4
'2.4 => 2-4
'1=>Y
'2=>B
'3=>K
'4=>G
'5=>T

'INPUT: [1D3-2.4-3]
'OUTPUT: [1D3K2-4], dong thoi thay doi input
'OUTPUT: ?
'Da chuyen ca ID cua BT PRo
Sub abb()
        Dim s As String, x As String
        s = "aaa[HH12.C8.6.D1.b]aaa" '2H1K3-8
        's = "aaaa[HH12.C8.6.D1.b]aaaa" '2H8K6-1
        x = chuyenidword(s)
        MsgBox x
End Sub
Function chuyenidword(ByRef s As String) As String
        Dim kq1 As String, kq As String
        chuyenidword = "?"
        kq1 = idwbt(s)
        If kq1 = "" Then GoTo thoat
        kq = chuyenidw(kq1)
        If kq = "" Then GoTo thoat
        kq = chuyenidw6(kq)
        If kq = "" Then GoTo thoat
        kq = "[" & kq & "]"
        s = Replace(s, kq1, kq, , , vbTextCompare)
        chuyenidword = " % " & kq
        Exit Function
    'BT PRO
thoat:
        chuyenidword = " % " & cidbt(s)
End Function
Private Function idwbt(ByVal str As String) As String
        Dim reg As Object
        Dim s   As String
        Dim Match, Matches
       
        idwbt = ""
       
        Set reg = CreateObject("VBScript.RegExp")
     
        With reg
            .Pattern = "(\[\d{1})([A-Z])([A-Z,0-9])(-)([A-Z,0-9])(\.)([A-Z,0-9])(-)([A-Z,0-9]\])"
            .IgnoreCase = False
            .Global = True
        End With
        Set Matches = reg.Execute(str)
     
        s = ""
        For Each Match In Matches
            s = Match.Value
            If s = "" Then Exit Function
            idwbt = s
            Exit Function
        Next Match
        idwbt = s
        Set reg = Nothing
End Function
Private Function chuyenidw6(ByVal s As String) As String

    Dim vt1 As Integer, vt2 As Integer
    Dim s1      As String, s2 As String
    Dim mucdo   As String

    Const c     As String = "-"
 
    On Error GoTo thoat
 
    s1 = Left(s, 3) '1D3-2.4-3 => 1D3
    s2 = Right(s, 1)
   
    chuyenidw6 = ""
 
    Select Case s2
        Case "1"
            mucdo = "Y"
        Case "2"
            mucdo = "B"
        Case "3"
            mucdo = "K"
        Case "4"
            mucdo = "G"
        Case "5"
            mucdo = "T"
    End Select
 
    vt1 = InStr(1, s, c, vbTextCompare)
    If vt1 = 0 Then GoTo thoat
    vt2 = InStrRev(s, c, , vbTextCompare)
    s2 = ""
    If vt1 < vt2 Then
        s2 = Mid(s, vt1 + 1, vt2 - 5)
        s2 = Replace(s2, ".", c, , , vbTextCompare)
    Else
        GoTo thoat
    End If
    chuyenidw6 = s1 & mucdo & s2
thoat:
    Err.Clear
End Function

'INPUT: abc[123]
'OUTPUT:123
Private Function chuyenidw(ByVal s As String) As String
    On Error GoTo thoat
 
    Dim vt1 As Integer, vt2 As Integer
    Dim kq  As String
    Const c1    As String = "["
    Const c2    As String = "]"
   
    chuyenidw = ""
 
    If s = "" Then Exit Function
    vt1 = InStr(1, s, c1, vbTextCompare)
    If vt1 = 0 Then Exit Function
    vt2 = InStr(vt1, s, c2, vbTextCompare)
    If vt2 > vt1 Then
        kq = Mid(s, vt1 + 1, vt2 - vt1 - 1)
    End If
thoat:
    Err.Clear
    chuyenidw = kq
End Function

Private Function cidbt(ByRef s As String) As String
        Dim kq As String, kq2 As String
        kq = ""
        kq = idwbt2(s)
        kq2 = cidwbt(kq)
       
        If kq2 = "" Then
            cidbt = "?"
        Else
            kq2 = "[" & kq2 & "]"
            s = Replace(s, kq, kq2, , , vbTextCompare)
            cidbt = kq2
        End If
End Function
Private Function idwbt2(ByVal str As String) As String
        Dim reg As Object
        Dim s   As String
        Dim Match, Matches
        idwbt2 = ""
        Set reg = CreateObject("VBScript.RegExp")
     
        With reg
            .Pattern = "\[[A-Z]{2}\d{2}\.[A-Z]\d{1,2}\.\d{1,2}\.[A-Z]\d{1,2}\.[a-z]\]"
            .IgnoreCase = False
            .Global = True
        End With
        Set Matches = reg.Execute(str)
     
        s = ""
        For Each Match In Matches
            s = Match.Value
            If s = "" Then Exit Function
            idwbt2 = s
            Exit Function
        Next Match
        idwbt2 = s
        Set reg = Nothing
End Function
Private Function cidwbt(ByVal s2 As String) As String
        Dim arr
        Dim kq As String
        Dim s   As String
        Dim i As Integer
       
        Dim mon     As String
        Dim monx    As String   'C, D, H
       
        Dim lop     As String   '10: HO10
        Dim lopx    As String
       
        Dim chuong  As String
       
        Dim bai     As String
       
        Dim dang    As String
       
        Dim md      As String
        Dim mdx     As String
        cidwbt = ""
        s = Replace(s2, "[", "")
        s = Replace(s, "]", "")
       
        kq = ""
        On Error GoTo thoat
        arr = Split(s, ".")
        'Mon: HO = C, DS = D, HH = H
        mon = Left(CStr(arr(0)), 2)
        Select Case mon
            Case "DS"
                monx = "D"
            Case "HH"
                monx = "H"
            Case "HO"
                monx = "C"
            Case Else
                GoTo thoat
        End Select
        lop = Right(CStr(arr(0)), 2)
        Select Case lop
            Case "10"
                lopx = "0"
            Case "11"
                lopx = "1"
            Case "12"
                lopx = "2"
            Case Else
                GoTo thoat
        End Select
       
        chuong = UCase(CStr(arr(1)))
        chuong = Right(chuong, Len(chuong) - 1)
       
        If IsNumeric(chuong) = True Then
            If Val(chuong) < 10 Then
                chuong = CStr(Val(chuong))
            Else
                chuong = Chr(Val(chuong) + 55)
            End If
        Else
            GoTo thoat
        End If
       
       
       
        bai = CStr(arr(2))
        bai = CStr(Val(bai))
       
        If IsNumeric(bai) = True Then
            If Val(bai) < 10 Then
                bai = CStr(Val(bai))
            Else
                bai = Chr(Val(bai) + 55)
            End If
        Else
            GoTo thoat
        End If
       
        dang = UCase(CStr(arr(3)))
        dang = Right(dang, Len(dang) - 1)
       
        If IsNumeric(dang) = True Then
            If Val(dang) < 10 Then
                dang = CStr(Val(dang))
            Else
                dang = Chr(Val(dang) + 55)
            End If
        Else
            GoTo thoat
        End If
       
       
       
        md = CStr(arr(4))
        md = LCase(md)
        Select Case md
            Case "a"
                mdx = "B"
            Case "b"
                mdx = "K"
            Case "c"
                mdx = "G"
            Case "d"
                mdx = "T"
            Case Else
                GoTo thoat
        End Select
       
        cidwbt = lopx & monx & chuong & mdx & bai & "-" & dang
        Exit Function
       
thoat:
        cidwbt = ""
End Function
 

tuhocvba

Administrator
Thành viên BQT
Mã:
Sub test102021()
    Dim s As String, x As String
    s = "aaa[1D3K2-4]"
    x = nhandienid(s, "")
    MsgBox x
End Sub
'Thay ID_OLD thanh ID_NEW
'Neu snew = "" : ReadOnly
'INPUT: [1D3K2-4], snew: 1D3K5-4
'OUTPUT: thay [1D3K5-4] vao s, ket qua cua ham la : 1D3K2-4
Function nhandienid(ByRef str As String, ByVal snew As String) As String
        Dim reg As Object
        Dim s   As String, kq As String
        Dim Match, Matches
        
    
        kq = str
        nhandienid = "?"
        Set reg = CreateObject("VBScript.RegExp")
      
        With reg
            .Pattern = "(\[\d{1})([A-Z])([A-Z,0-9])([A-Z])([A-Z,0-9])(-)([A-Z,0-9])(\])"
            .IgnoreCase = False
            .Global = True
        End With
        Set Matches = reg.Execute(str)
      
        s = ""
        For Each Match In Matches
            s = Match.Value
            If s <> "" Then
                If snew <> "" Then
                    kq = Replace(kq, s, "[" & snew & "]", , , vbTextCompare)
                End If
                nhandienid = s
            End If
            
        Next Match
        str = kq
        Set reg = Nothing
        nhandienid = Replace(nhandienid, "[", "", , , vbTextCompare)
        nhandienid = Replace(nhandienid, "]", "", , , vbTextCompare)
End Function
 
Top