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

tuhocvba · 2/8/21

Thuật toán đảo đáp án đã được làm khá tốt. Mình đã kiểm tra và thấy không có vấn đề gì. Với các câu lựa chọn đáp án mà chứa dấu % thì Tool vẫn xử lý tốt. Vậy thầy cô sử dụng Tool bình thường.

tuhocvba · 2/8/21

Tuy không ảnh hưởng tới việc đảo đề, nhưng chức năng đọc đáp án bị ảnh hưởng. Mặc dù gói Ex Test cũng hỗ trợ đọc đáp án. Nhưng mình không muốn một thứ gì chưa hoàn thiện. Code vài dòng cho ổn định hẳn vậy.

Mã:

Sub daodapan(ByRef s2 As String, ByVal bda4 As Boolean)
    Dim arr
    Dim brr
    Dim n As Integer, i As Integer
    Dim stemp1 As String, stemp2 As String, phuongan As String
    Dim s   As String
    Const THAYTHEPHANTRAM   As String = "@~"
    Const KYTUGAYNHIEU          As String = "\%"
    On Error GoTo thoat
    
    s = s2
    s = Replace(s, KYTUGAYNHIEU, THAYTHEPHANTRAM, , , vbTextCompare)
    arr = tachlayloigiai(s, bda4)
    
    If IsArray(arr) = False Then Exit Sub
    
    
    n = UBound(arr, 2)
    If arr(3, n) = Empty Then Exit Sub '11/7/2021: Phong tranh dao dap an linh tinh
    ReDim brr(1 To n)
    
    Call napgiatrimangngaunhien(brr)
    
    'Dao dap an
    For i = n To 1 Step -1
        stemp1 = Left(s, arr(2, i) - 1)
        stemp2 = Right(s, Len(s) - arr(3, i))
        phuongan = arr(1, brr(i))
        s = stemp1 & phuongan & stemp2
    Next i
    s2 = s
    s2 = Replace(s, THAYTHEPHANTRAM, KYTUGAYNHIEU, , , vbTextCompare)
thoat:

End Sub

tuhocvba · 2/8/21

Ngoài thủ tục trên, cần phải sửa thêm thủ tục này:

Mã:

tachlayloigiai

Đã sửa trên cả 2 file, đã đọc đáp án chính xác.

Liên quan tới kiểm tra câu hỏi trùng lặp, trên file 1-, cập nhật code cho thủ tục: kiemtradulieu.

tuhocvba · 13/8/21

@NhanSu có thời gian đọc qua topic này nhé. Có việc liên quan tới thuật toán cần bạn hỗ trợ mà tôi sẽ trao đổi sau.

tuhocvba · 14/8/21

@NhanSu : Có thời gian xem nhé.
File :

Bạn cần đăng nhập để thấy link

trong file có để sẵn code tham khảo (ấn Alt +F11). Code này xử lý được toàn bộ các trường hợp.
Nhưng còn trường hợp {A}{B}{C}{D} thì chưa xử lý được.

NhanSu · 14/8/21

@tuhocvba trong file bạn gửi chỉ thấy có file excel, không có dữ liệu mẫu nên không test được và mình cũng chưa rõ các "trường hợp" ở đây là gì? Theo mình, vì file đầu vào có cấu trúc không chuẩn (ví dụ có dòng trống, khoảng trắng ở đầu...) nên thiết kế 1 thủ tục để chuẩn hóa dữ liệu trước khi làm các bước tiếp theo.

tuhocvba · 14/8/21

NhanSu nói:
@tuhocvba trong file bạn gửi chỉ thấy có file excel, không có dữ liệu mẫu nên không test được và mình cũng chưa rõ các "trường hợp" ở đây là gì? Theo mình, vì file đầu vào có cấu trúc không chuẩn (ví dụ có dòng trống, khoảng trắng ở đầu...) nên thiết kế 1 thủ tục để chuẩn hóa dữ liệu trước khi làm các bước tiếp theo.

Dữ liệu đọc luôn trên excel đó . Xử lý đầu vào trên excel luôn nha.

tuhocvba · 14/8/21

Tất cả các ví dụ ghi trên file excel gửi cho bạn gọi là các trường hợp . Code hiện tại đọc được vị trí các lựa chọn, trừ trường hợp nếu họ gõ các lựa chọn trên cùng một hàng là chịu .
Không có chuẩn nào, chỉ có vứt bỏ comment và khoảng trắng đầu dòng để tiện xử lý thôi .
@NhanSu

NhanSu · 14/8/21

@tuhocvba Function xacdinhdaungoac bị xóa rồi nên mình chưa test được.

tuhocvba · 14/8/21

NhanSu nói:
@tuhocvba Function xacdinhdaungoac bị xóa rồi nên mình chưa test được.

Mã:

Function xacdinhdaungoac(ByVal s As String, vitri As Integer, sokytu As Integer) As String
    If s = "" Or vitri = 0 Then
        xacdinhdaungoac = ""
        Exit Function
    End If
    xacdinhdaungoac = Mid(s, vitri, sokytu)
End Function

tuhocvba · 14/8/21

Để cho đơn giản, mặc định văn bản đầu vào của bạn cần xử lý không có khoảng trắng đầu dòng. Và cũng không có comment %....
Nội dung trong excel đưa về chuẩn như trên và xử lý xem sao.
Loại bỏ luôn, không có dòng trống, cho dễ xử lý nha.
@NhanSu

tuhocvba · 14/8/21

@NhanSu Vừa cập nhật bài trên, tôi sẽ cho bạn chuỗi ký tự có chuẩn như trên. Bạn xử lý trong trường hợp lý tưởng đó.
Chú ý:
Lựa chọn đáp án có thể viết trên nhiều dòng.
Các lựa chọn đáp án có thể viết trên cùng một dòng.

NhanSu · 14/8/21

OK, để mình thử xem.

tuhocvba · 14/8/21

NhanSu nói:
OK, để mình thử xem.

Cố lên. @Euler nó bảo chỉ cần 1h là nó code được.

NhanSu · 14/8/21

@tuhocvba nếu vậy thì để @Euler code đi, mình đến đêm nay mới ngồi được, đang ở chỗ làm phải về nhà vì con ốm.

tuhocvba · 14/8/21

NhanSu nói:
@tuhocvba nếu vậy thì để @Euler code đi, mình đến đêm nay mới ngồi được, đang ở chỗ làm phải về nhà vì con ốm.

Chăm con đi. Khi nào rảnh thì làm.

NhanSu · 14/8/21

@tuhocvba thử·xem mình có hiểu đúng câu hỏi không? Mình chỉ tìm đáp án bắt đầu từ "\choice" và trước "\loigiai". Code lỗi đã sửa ở bài dưới

Bạn cần đăng nhập để thấy link

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
 
    StartSearchingPos = InStr(s, Key) + Len(Key)
    s1 = Mid(s, StartSearchingPos, Len(s) - StartSearchingPos - InStr(s, loigiai))
 
    If RegExp Is Nothing Then
        Set RegExp = CreateObject("VBScript.RegExp")
    End If
    With RegExp
        .Global = True
        .Pattern = "[^{}]"
        s1 = .Replace(s1, "")
    End With
    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

tuhocvba · 16/8/21

Cảm ơn @NhanSu . Mình vừa kiểm tra.
Câu 3 chết dù mình chèn thêm \loigiai{} vào.

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

Mã:

Vật thể nào trong các vật thể sau không phải là
khối đa diện?
\choice
{x^{21}+{u_1}^2}
{x^{21}+{u_2}^2}
{x^{22}+{u_3}^2}
{\True x^{23}+{u_3}^2}
\loigiai{
}

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

Câu 4 chết, chỉ đọc được 3 đáp án. (tương tự câu 3, chèn \loigiai{} vô vẫn chết)

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

Câu 5 chết, chỉ đọc được 3 đáp án, tương tự hai câu trên.
Câu 6 chết.
Câu 7 chết.

NhanSu · 16/8/21

Mình sửa lại code, may mà sai ngay lệnh tách chuỗi s1, link vẫn ở bài cũ:

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
    
    StartSearchingPos = InStr(s, Key) + Len(Key)
    's1 = Mid(s, StartSearchingPos, Len(s) - StartSearchingPos - InStr(s, loigiai))
    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")
    End If
    With RegExp
        .Global = True
        .Pattern = "[^{}]"
        s1 = .Replace(s1, "")
    End With
    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

tuhocvba · 16/8/21

Chạy rất nhiều trường hợp mà chưa thấy chết.
Chỗ này có lẽ nên thêm một đoạn code để khi đếm đủ số lượng đáp án thì thoát Do~Loop không cho đếm nữa.

Mã:

If k > 0 Then Exit Do
If CountAns = slda Then Exit Do
CountAns = CountAns + 1

Dòng code số 2 là mình thêm.
Nếu code cũ, mà chạy trường hợp này thì nó đang ra 5 đáp án. (đúng là 4).

Mã:

\begin{ex}
\immini
{
vanban
 \choice {dap an1} {dap an2} {dap an3}{dap an 4}

{
 hinh ve
}
\end{ex}

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

Administrator

Administrator

Administrator

Administrator

Administrator

SMod

Administrator

Administrator

SMod

Administrator

Administrator

Administrator

SMod

Administrator

SMod

Administrator

SMod

Administrator

SMod

Administrator