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

tuhocvba

Administrator
Thành viên BQT
1. Đặt vấn đề:
Hiện nay có hai gói sử dụng trong môi trường Tex để tạo ra đề thi trắc nghiệm, trong đó phải kể tới ex test do thầy Tuấn phát triển, và gói dethi do thầy Điển phát triển.
Bất chấp có những khác biệt ở cả hai gói này, chúng đều được mọi người đón nhận. Cái này là do thói quen người dùng, ai dùng quen món nào thì sử dụng món đó. Ở trình độ của mình thì không dám lạm bàn gói nào ưu điểm hơn gói nào.

Tex có khả năng mạnh mẽ là hỗ trợ soạn thảo, tạo ra những tài liệu đẹp mắt. Nhưng nếu coi nó là công cụ quản lý cơ sở dữ liệu thì không đúng. Việc lưu trữ bài tập làm thư viện tạo đề thi trên Tex và coi nó là cơ sở dữ liệu cũng chưa thỏa đáng.

Do đó tôi muốn có một công cụ VBA, convert các file tex (định dạng ex test hay định dạng gói dethi) và chung một nơi quản lý đó là Excel. Do Excel không hiển thị được công thức toán, do đó các thầy cô vẫn lưu trữ bài tập trên Tex như bình thường. Nhưng thông qua VBA, nó sẽ lấy dữ liệu từ Tex và lưu trữ về Excel, đồng thời nhờ khả năng xử lý tốt, VBA có thể đảo vị trí câu hỏi, sau đó sắp xếp lại theo định dạng của gói dethi hay gói ex test, từ đó tạo ra file đề thi (.tex) theo một trong hai định dạng nói trên.

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

tuhocvba

Administrator
Thành viên BQT
2. Đọc file tex và trích xuất dữ liệu ra Excel:
Trước hết ta hãy xem cấu trúc file tex của gói ex test:
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$}
{$2\sqrt3$}
\loigiai{
}
\end{ex}
Các câu hỏi được bao bởi từ khóa \begin{ex}\end{ex}. Trong file tất nhiên đoạn như vậy lặp đi lặp lại rất nhiều lần tương ứng với số lượng câu hỏi mà nó chứa. Chúng ta cần trích xuất dữ liệu phần nằm giữ beginend.
Vấn đề thuật toán tới đây các bạn đã hình dung ra được.
Nghe nói hiện nay form trên có điều chỉnh một chút, đó là câu hỏi sẽ có thêm thông tin ID được khai báo ở ngay dòng đầu:
Mã:
\begin{ex}%[ID]
Cách đánh số ID này theo một nguyên tắc khá khắt khe, cá nhân tôi thấy là không cần thiết, tôi nghĩ khi đã xuất ra Excel rồi thì tôi có thể để người dùng tùy ý để điều kiện lọc theo cách mà họ muốn, bởi khả năng lọc của Excel rất mạnh mẽ. Tuy nhiên tôi cũng không muốn xung đột với những gì mà người khác đã làm, do đó nội dung ID này tôi cũng sẽ cho VBA lấy về và ghi vào Excel theo định dạng:
Bạn cần đăng nhập để thấy đính kèm


Đến đây chúng ta có một bài toán nhỏ:
Vì từ khóa \begin{ex} là rất rõ ràng, cho nên xác định nó ở dòng nào trong văn bản là không khó. Tiếp theo xác định dấu [ và lấy phần nội dung cho tới khi nào gặp dấu ] thì dừng.

Về vấn đề kỹ thuật, tôi cho rằng sử dụng ADO để lấy dữ liệu file tex sẽ cho tốc độ nhanh nhất.
 

tuhocvba

Administrator
Thành viên BQT
3. Đảo đáp án
Nghe nói cái gói ex test có kèm theo file random hỗ trợ trộn đáp án. Mà mình vác về máy dùng thấy không được, chả hiểu cái gì không tương thích. Cũng không muốn mất công tìm hiểu. Bởi trong đầu đã định hình sẵn, mình sẽ tự đảo đáp án nếu cần.

Trước khi đảo đáp án thì phải trích xuất ra được đáp án.

Nào bây giờ chúng ta có cấu trúc một câu hỏi như sau:
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$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
\end{ex}
Có mấy điều kiện giả thiết như sau:
Phần chữ viết sau dấu % trên cùng một hàng sẽ không có giá trị, bởi chúng là comment. Điều này cũng tương tự như VBA, mọi ký tự trong cùng hàng viết sau dấu ' thì đều trở thành comment.

Do đó tôi lọc bỏ dấu comment đi.
Các câu hỏi đáp án chính là phần sau từ khóa \choice :
Mã:
{$2$}
{$\sqrt3$}
{\True $6$}
{$2\sqrt3$}
Ở trên có 4 đáp án, mỗi đáp án đều được viết bao bọc bởi { }.
Nếu nội dung câu đáp án quá dài thì dấu kết thúc } có thể nằm ở vị trí hàng tiếp theo, không nhất thiết cùng hàng với dấu mở đầu {.
Tuy nhiên quan sát các đề thi, thì tính bất biến là dấu { luôn ở đầu dòng. Tôi cũng thấy đây là cách biên soạn sáng sủa, do đó chúng ta coi đây là điều kiện bất biến để lập trình.

Cách nghĩ là:
-Bắt đầu tìm thấy từ khóa \choice thì kích hoạt bộ tìm kiếm nội dung các đáp án.
-Nếu đầu dòng là { thì coi như bắt đầu nội dung của một câu đáp án mới. Bắt đầu chạy từ đây cho tới khi nào gặp dấu } thì dừng. Ta thu được nội dung đáp án thứ nhất.
[Vòng lặp trên cứ lặp lại cho tới khi không tìm thấy gì nữa]
Giá trị tìm được sẽ lưu vào mảng.

Bây giờ tôi sẽ kiểm tra thử, tôi cho nội dung này vào cells A1:
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$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
\end{ex}

Bây giờ là code VBA:
Mã:
Sub test()
    Dim arr
    Dim s As String
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
  
    arr = tachlayloigiai(s)
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da(1 To 4)
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
  
    arr = Split(s, Chr(10))
  
    For i = LBound(arr) To UBound(arr, 1) Step 1
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
      
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ndch = c1
            End If
            If bdch = True Then
                For j = 2 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c2 Then
                        bdch = False
                        da(cnt) = ndch
                        ndch = ""
                        Exit For
                    End If
                Next j
            End If
        End If
    Next i
  
  
    tachlayloigiai = da
End Function
Kết quả thì đúng rồi.
Bạn cần đăng nhập để thấy đính kèm

Nhưng code trên cứ thấy dài lê thê sao đó. Cảm thấy chưa được hay lắm. Bạn nào có code hay hơn không nhỉ?
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Sau khi đọc lại code, tôi thấy nó có một điểm chưa ổn. Chẳng hạn input như sau:
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$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
{abc}
\end{ex}
Khi đó nó đưa cả {abc} vào output. Đây là điều tôi không muốn. Sau khi tìm ra đáp án, nếu xuất hiện lệnh mới thì phải dừng tìm kiếm. Do đó, tôi sẽ sửa lại code như sau để chặt chẽ hơn:
Mã:
Sub test()
    Dim arr
    Dim s As String
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
   
    arr = tachlayloigiai(s)
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
   
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 1)
   
    For i = LBound(arr) To UBound(arr, 1) Step 1
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
       
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ndch = c1
            End If
            If bdch = True Then
                For j = 2 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c2 Then
                        bdch = False
                        ReDim Preserve da(1 To cnt)
                        da(cnt) = ndch
                        ndch = ""
                        Exit For
                    End If
                Next j
            End If
        End If
        If bd = True And temp <> "" And Left(temp, 1) <> c1 And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
    tachlayloigiai = da
End Function
 

tuhocvba

Administrator
Thành viên BQT
@haokira thử giải bài toán đặt ra ở #3.
Tóm lại như này:
INPUT là chuỗi string, có thể ghi vào cells A1.
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$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
{abc}
\end{ex}
OUTPUT mong muốn ghi 4 cái tìm được này vào mảng:
Mã:
{$2$}
{$\sqrt3$}
{\True $6$}
{$2\sqrt3$}
 
Code ở #4 anh chỉ cần viết ở đoạn cuối như này:
Mã:
 End If
        If bd = True And temp <> "" And Left(temp, 1) <> c1 And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
   
thoat:
    If cnt > 0 Then
        tachlayloigiai = da
    End If
End Function
thì cũng là kết quả chính xác.
 

tuhocvba

Administrator
Thành viên BQT
OK. Không thấy bạn @haokira phản hồi gì, nhưng đoạn code sau tôi sẽ dùng ý tưởng mà bạn ấy đã nêu để giải quyết vấn đề phát sinh mà tôi sẽ trình bày dưới đây.
Đoạn code mà ta nói tới ở trên có một sai lầm là ta mặc định nội dung đáp án nằm bên trong { ...} thế nhưng bản thân nội dung đáp án là phần ... này nếu cũng chứa các dấu { } thì chúng ta sẽ đưa ra kết quả sai.
Tôi ví dụ input mà như dưới đây, chú ý dòng số 4
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^{2+3}$}
{$\sqrt3$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
{abc}
\end{ex}
thì đoạn code trên của chúng ta không thể giải quyết được.
Cho nên tôi sẽ đưa thêm một biến để đếm dấu ngoặc { và }, tôi gọi là cntdn.
Mã:
Sub test()
    Dim arr
    Dim s As String
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
   
    arr = tachlayloigiai(s)
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Dim cntdn   As Integer 'Dem dau ngoac {
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
   
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 1)
   
    For i = LBound(arr) To UBound(arr, 1) Step 1
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
       
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ndch = c1
                cntdn = 1
            End If
            If bdch = True Then
                For j = 2 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c1 Then cntdn = cntdn + 1
                    If ct = c2 Then
                        cntdn = cntdn - 1
                        If cntdn = 0 Then
                            bdch = False
                            ReDim Preserve da(1 To cnt)
                            da(cnt) = ndch
                            ndch = ""
                            Exit For
                        
                        End If
                    End If
                Next j
            End If
        End If
        If bd = True And temp <> "" And Left(temp, 1) <> c1 And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
        If cnt > 0 Then
            tachlayloigiai = da
        End If
End Function
Kết quả với input trên nó vẫn đưa ra chính xác là:
Bạn cần đăng nhập để thấy đính kèm
 

tuhocvba

Administrator
Thành viên BQT
Thông thường thi trắc nghiệm, thì nội dung mỗi câu lựa chọn cũng không quá dài. Tuy nhiên nếu mặc định như vậy và code thì sẽ không tránh khỏi những rắc rối trong tương lai. Biết đâu một ngày đẹp trời nào đó, hứng lên họ ra cái đề mà nội dung đáp án được gõ trên vài dòng thì code trên sẽ bất đắc kỳ tử với input như này:
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^{2+3}+
3^{x+y}$}
\\
{$\sqrt3$}%nội dung comment
{\True $6$}
{$2\sqrt3$}
\loigiai{
}
{abc}
\end{ex}
Do đó, tôi phải sửa lại dấu hiệu nhận biết như thế nào là hết phần nội dung lựa chọn đáp án như sau:
Mã:
Sub test()
    Dim arr
    Dim s As String
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
  
    arr = tachlayloigiai(s)
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Dim cntdn   As Integer 'Dem dau ngoac {
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
  
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 1)
  
    For i = LBound(arr) To UBound(arr, 1) Step 1
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
      
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ndch = c1
                cntdn = 1
            End If
            If bdch = True Then
                For j = 2 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c1 Then cntdn = cntdn + 1
                    If ct = c2 Then
                        cntdn = cntdn - 1
                        If cntdn = 0 Then
                            bdch = False
                            ReDim Preserve da(1 To cnt)
                            da(cnt) = ndch
                            ndch = ""
                            Exit For
                        
                        End If
                    End If
                Next j
            End If
        End If
        If bd = True And temp <> "" And Left(temp, 1) = dhkt And temp <> "\\" And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
        If cnt > 0 Then
            tachlayloigiai = da
        End If
End Function
 

tuhocvba

Administrator
Thành viên BQT
Ở đoạn code trên có một điểm chưa tốt :
Mã:
For j = 2 To Len(temp) Step 1
Bây giờ tôi muốn nói câu chuyện đảo đáp án.
Cả một đoạn văn bản đó ta coi là một chuỗi string s. Trong chuỗi string này có các đáp án A,B,C,D...
Bạn cần đăng nhập để thấy đính kèm

Nếu bây giờ các bạn cứ hồn nhiên mà dùng lệnh Replace, tôi e rằng chúng ta sẽ gặp rắc rối lớn. Bởi vì nội dung đáp án A nó còn có thể xuất hiện ở vị trí khác mà chúng ta không thể nào biết được.
Chẳng hạn ta có nội dung câu hỏi là x^{2+y}
Trong các đáp án có một đáp án ghi là {2+y}.
Như vậy chuỗi {2+y} này xuất hiện đâu chỉ một vị trí trong chuỗi s kia. Do đó dùng lệnh replace, tôi cho rằng rất nguy hiểm.
Tôi nghĩ sẽ chính xác hơn nếu ta xác định điểm bắt đầu và kết thúc của đáp án A.
Tương tự với các đáp án khác cũng vậy.

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


Bây giờ để thay đổi nội dung đáp án A thành một nội dung khác, thật ra rất đơn giản. Ta sẽ cắt s ra làm ba khúc.
Mã:
s1 = Left(s,vtbd-1)
s2 = Right(s,len(s)-vtkt)
s = s1 & noidungdapanmoi & s2
Bạn cần đăng nhập để thấy đính kèm


Tương tự với các đáp án khác cũng vậy.
Nhưng chúng ta phải làm với vị trí đáp án cuối cùng, như hình minh họa là D trước. Sau đó mới tới C, B, A.
Bởi vì, nếu ta thực hiện đổi nội dung đáp án ở vị trí A đầu tiên. Do nội dung đáp án mới có thể có độ dài khác với đáp án cũ, khi đó các thông tin vtbd & vtkt của các đáp án B, C, D sẽ xê dịch theo. Vì vậy mà ta phải làm từ vị trí đáp án D ngược lên đầu.

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


Nào, trước hết tôi cần lấy thông tin vtbd và vtkt của mỗi câu đáp án.
Mã:
Sub test()
    Dim arr
    Dim s As String
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
    arr = tachlayloigiai(s)
    
    ThisWorkbook.Sheets(1).Cells(2, 1) = arr(1, 1)
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    'noi dung cau hoi:
    'vi tri bat dau:
    'vi tri ket thuc
    
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Dim cntdn   As Integer 'Dem dau ngoac {
    Dim contro  As Integer
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
   
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 3, 1 To 1)
   
    For i = LBound(arr) To UBound(arr, 1) Step 1
        
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
       
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ReDim Preserve da(1 To 3, 1 To cnt)
                
                da(2, cnt) = contro + InStr(1, CStr(arr(i)), c1) 'vi tri bat dau
            End If
            If bdch = True Then
                For j = 1 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c1 Then cntdn = cntdn + 1
                    If ct = c2 Then
                        cntdn = cntdn - 1
                        If cntdn = 0 Then
                            bdch = False
                            ReDim Preserve da(1 To 3, 1 To cnt)
                            da(1, cnt) = ndch
                            ndch = ""
                            da(3, cnt) = contro + InStr(1, CStr(arr(i)), temp) + j - 1 'vi tri ket thuc
                            Exit For
                        
                        End If
                    End If
                Next j
            End If
        
        End If
        If bdch = True Then ndch = ndch & Chr(10)
        contro = contro + 1 + Len(CStr(arr(i)))
        If bd = True And temp <> "" And Left(temp, 1) = dhkt And temp <> "\\" And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
        If cnt > 0 Then
            tachlayloigiai = da
        End If
End Function
Lưu ý, ký tự xuống dòng cũng coi là 1 ký tự. Kết quả được như sau:
Bạn cần đăng nhập để thấy đính kèm
 

tuhocvba

Administrator
Thành viên BQT
Nào bây giờ tôi sẽ hiện thực hóa ý tưởng trên.
Trong đó lưu ý các bạn, để thực hiện lấy số ngẫu nhiên thì tôi sẽ lấy mẫu code .
Bạn cần đăng nhập để thấy đính kèm

Bằng suy nghĩ như trên, tôi sẽ thực hiện đảo đáp án ngẫu nhiên, kết hợp với bài viết ở trên, tôi sẽ đưa đáp án ngẫu nhiên vào nội dung câu hỏi vốn có.
Cụ thể tôi có input ở cells A1 như sau:
Bạn cần đăng nhập để thấy đính kèm

Tôi sẽ thực hiện chuyển thứ tự đáp án đi bằng code như sau:
Mã:
Sub test()
    Dim arr
    Dim brr
    Dim s As String
    Dim n As Integer, i As Integer
    Dim stemp1 As String, stemp2 As String, phuongan As String
    
    
    s = ThisWorkbook.Sheets(1).Cells(1, 1)
    arr = tachlayloigiai(s)
    
    If IsArray(arr) = False Then GoTo thoat
    
    n = UBound(arr, 2)

    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
thoat:
    ThisWorkbook.Sheets(1).Cells(1, 2) = s
    
    
End Sub

Sub napgiatrimangngaunhien(ByRef crr As Variant)
    Dim i As Long
    Dim brr
    
    ReDim brr(LBound(crr) To UBound(crr))
    For i = LBound(crr) To UBound(crr) Step 1
        Call Randomize
        brr(i) = Rnd
    Next i
    For i = LBound(crr) To UBound(crr) Step 1
        crr(i) = Rankgiamdan(brr, i)
    Next i
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    'noi dung cau hoi:
    'vi tri bat dau:
    'vi tri ket thuc
    
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Dim cntdn   As Integer 'Dem dau ngoac {
    Dim contro  As Integer
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
  
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 3, 1 To 1)
  
    For i = LBound(arr) To UBound(arr, 1) Step 1
        
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
      
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ReDim Preserve da(1 To 3, 1 To cnt)
                
                da(2, cnt) = contro + InStr(1, CStr(arr(i)), c1) 'vi tri bat dau
            End If
            If bdch = True Then
                For j = 1 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c1 Then cntdn = cntdn + 1
                    If ct = c2 Then
                        cntdn = cntdn - 1
                        If cntdn = 0 Then
                            bdch = False
                            ReDim Preserve da(1 To 3, 1 To cnt)
                            da(1, cnt) = ndch
                            ndch = ""
                            da(3, cnt) = contro + InStr(1, CStr(arr(i)), temp) + j - 1 'vi tri ket thuc
                            Exit For
                        
                        End If
                    End If
                Next j
            End If
        
        End If
        If bdch = True Then ndch = ndch & Chr(10)
        contro = contro + 1 + Len(CStr(arr(i)))
        If bd = True And temp <> "" And Left(temp, 1) = dhkt And temp <> "\\" And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
        If cnt > 0 Then
            tachlayloigiai = da
        Else
            tachlayloigiai = s
        End If
End Function

Function Rankgiamdan(arr As Variant, j As Long) As Long
    'Tim vi tri cua mot phan tu trong mang la vi tri thu may
    Dim i As Long

    For i = 1 To UBound(arr)
        'Tim theo vi tri giam dan
        If arr(j) = WorksheetFunction.Large(arr, i) Then
            Rankgiamdan = i
            Exit For
        End If
    Next

End Function
Kết quả được thể hiện ở ô B1 như sau:
Bạn cần đăng nhập để thấy đính kèm

Ở hình trên các bạn đã thấy, các phương án lựa chọn đã bị đảo ngẫu nhiên.
 

tuhocvba

Administrator
Thành viên BQT
Nhìn code thì loằng ngoằng như vậy, nhưng các bạn yên tâm, bằng cách sử dụng thủ tục nọ gọi thủ tục kia, hàm nọ gọi hàm kia, bộ nhớ được giải phóng liên tục, do đó máy tính xử lý rất nhanh mà không tốn bộ nhớ.
Sau đây tôi test thử với dữ liệu có khoảng 100 câu hỏi như này:
Bạn cần đăng nhập để thấy đính kèm

Tôi sẽ cho thực thi đảo đáp án và ghi kết quả sang cột B.
Mã:
Sub test()
    Dim i As Integer
    Dim s As String
    
    With ThisWorkbook.Sheets(1)
        For i = 1 To 97 Step 1
            s = .Cells(i, 1)
            Call daodapan(s)
            .Cells(i, 2) = s
        Next i
    End With
End Sub

Sub daodapan(ByRef s As String)
    Dim arr
    Dim brr
    Dim n As Integer, i As Integer
    Dim stemp1 As String, stemp2 As String, phuongan As String
    
    
    
    arr = tachlayloigiai(s)
    
    If IsArray(arr) = False Then Exit Sub
    
    n = UBound(arr, 2)

    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

End Sub

Sub napgiatrimangngaunhien(ByRef crr As Variant)
    Dim i As Long
    Dim brr
    
    ReDim brr(LBound(crr) To UBound(crr))
    For i = LBound(crr) To UBound(crr) Step 1
        Call Randomize
        brr(i) = Rnd
    Next i
    For i = LBound(crr) To UBound(crr) Step 1
        crr(i) = Rankgiamdan(brr, i)
    Next i
End Sub
Function tachlayloigiai(s As String)
    Dim i       As Integer, j As Integer, vt As Integer
    Dim temp    As String, ndch As String, ct  As String
    Dim arr
    Dim da
    'noi dung cau hoi:
    'vi tri bat dau:
    'vi tri ket thuc
    
    Dim bd      As Boolean 'Bat dau tim thay choice thi gan bd = true
    Dim bdch    As Boolean
    Dim cnt     As Byte
    Dim cntdn   As Integer 'Dem dau ngoac {
    Dim contro  As Integer
    Const Key   As String = "\choice"
    Const cm    As String = "%"
    Const c1    As String = "{"
    Const c2    As String = "}"
    Const dhkt  As String = "\"
  
    arr = Split(s, Chr(10))
    
    ReDim da(1 To 3, 1 To 1)
  
    For i = LBound(arr) To UBound(arr, 1) Step 1
        
        vt = InStr(1, CStr(arr(i)), cm) '%
        If vt > 0 Then
            temp = Trim(Left(CStr(arr(i)), vt - 1))
        Else
            temp = Trim(CStr(arr(i)))
        End If
      
        If InStr(1, temp, Key) > 0 Then
            bd = True
        End If
        If bd = True And temp <> "" Then
            
            If Left(temp, 1) = c1 And bdch = False Then
                bdch = True
                cnt = cnt + 1
                ReDim Preserve da(1 To 3, 1 To cnt)
                
                da(2, cnt) = contro + InStr(1, CStr(arr(i)), c1) 'vi tri bat dau
            End If
            If bdch = True Then
                For j = 1 To Len(temp) Step 1
                    ct = Mid(temp, j, 1)
                    ndch = ndch & ct
                    If ct = c1 Then cntdn = cntdn + 1
                    If ct = c2 Then
                        cntdn = cntdn - 1
                        If cntdn = 0 Then
                            bdch = False
                            ReDim Preserve da(1 To 3, 1 To cnt)
                            da(1, cnt) = ndch
                            ndch = ""
                            da(3, cnt) = contro + InStr(1, CStr(arr(i)), temp) + j - 1 'vi tri ket thuc
                            Exit For
                        
                        End If
                    End If
                Next j
            End If
        
        End If
        If bdch = True Then ndch = ndch & Chr(10)
        contro = contro + 1 + Len(CStr(arr(i)))
        If bd = True And temp <> "" And Left(temp, 1) = dhkt And temp <> "\\" And bdch = False And cnt > 0 Then GoTo thoat:
    Next i
    
    tachlayloigiai = da
    Exit Function
thoat:
        If cnt > 0 Then
            tachlayloigiai = da
        Else
            tachlayloigiai = s
        End If
End Function

Function Rankgiamdan(arr As Variant, j As Long) As Long
    'Tim vi tri cua mot phan tu trong mang la vi tri thu may
    Dim i As Long

    For i = 1 To UBound(arr)
        'Tim theo vi tri giam dan
        If arr(j) = WorksheetFunction.Large(arr, i) Then
            Rankgiamdan = i
            Exit For
        End If
    Next

End Function
Kết quả:
Bạn cần đăng nhập để thấy đính kèm


Hết 0.14s. Đây là con số lý tưởng rồi, bởi vì một đề thi toán, thì cũng chỉ có tới 50 câu mà thôi.
Chỉ với thao tác này thôi, chúng ta đã có thể tạo ra vô vàn đề thi khác nhau, đấy là chưa làm tới mức đảo vị trí câu hỏi.
 

tuhocvba

Administrator
Thành viên BQT
Như vậy, tôi đã giải quyết xong các vấn đề thuật toán chính.
Bây giờ tôi sẽ quay về việc thiết kế giao diện người dùng.
4. Thiết kế giao diện người dùng.
Tôi nghĩ sẽ cần 2 file chứa macro Tool & Form.
File 1: Thực hiện convert file tex => excel.
Tôi gọi đây là file Tool.
Ở nơi này, người dùng sẽ chọn link folder chứa các file .Tex, sau đó tích chọn file nào cần biên dịch ra Excel.
Bạn cần đăng nhập để thấy đính kèm


Tới đây liên quan tới kiến thức , nếu bạn chưa nắm được thì xem lại bài Listbox nhé.
Khi người dùng ấn Run thì sẽ phải qua bước xác nhận Input. Ở đây tôi có thủ tục xacnhaninput. Nó xác nhận bạn đã tích chọn tệp tin nào hay chưa. Nếu chưa tích chọn tệp tin nào thì đương nhiên là phải dừng, không cho thực thi, vì chẳng biết người dùng muốn gì.

Ở phần này tôi hơi phân vân, đó là tìm kiếm file ở folder, hay tìm kiếm cả ở Sub folder. Nếu tìm kiếm ở cả subfolder, đường dẫn bên trong quá sâu, có thể làm treo máy. Tôi nghĩ giáo viên họ soạn bài thì sẽ theo lớp, theo chương, do đó, tôi sẽ cho họ tìm kiếm ở cả subfolder nhưng sẽ có cảnh báo khi sử dụng.
 

tuhocvba

Administrator
Thành viên BQT
Tôi tạm gác giao diện người dùng, quay trở lại vấn đề thuật toán cuối cùng, đó là tạo ra file đáp án.
Sau khi tạo đề thi, thì việc không thể thiếu đó là tạo ra file đáp án. Mặc dù gói ex test có hỗ trợ tạo ra file đáp án, nhưng tôi cũng không muốn phụ thuộc vào nó.

5. Tạo file đáp án
Bạn cần đăng nhập để thấy đính kèm


Nội dung:
Tôi có chuỗi string như sau:
Mã:
\choice
{$a\sqrt3$}
{\True $\dfrac{a\sqrt3}4$}
{$\dfrac{a\sqrt3}2$}
{$\dfrac{a\sqrt3}6$}
\loigiai{
}
Nhiệm vụ của chúng ta là phải đọc để ra được đáp án là B. Vì chúng ta đã có Funtion tachlayloigiai rồi, cho nên tôi tận dụng luôn như sau:
Mã:
Sub test()
    Dim i As Integer
    Dim s As String

    With ThisWorkbook.Sheets(1)
        
            s = .Cells(1, 1)
        
            MsgBox docdapan(s)
   
    End With
End Sub
'INPUT STRING
'OUTPUT: A
Function docdapan(ByVal s As String) As String
    Dim arr
    Dim n As Integer, i As Integer
    Dim phuongan As String
    Const keydapan As String = "\True"
    
    
    arr = tachlayloigiai(s)
    
    If IsArray(arr) = False Then Exit Function
    
    n = UBound(arr, 2)

    'Dao dap an
    For i = n To 1 Step -1
        
        phuongan = arr(1, i)
        If Len(phuongan) > 1 Then
            phuongan = Right(phuongan, Len(phuongan) - 1)
            phuongan = Trim(phuongan)
            If InStr(1, phuongan, keydapan, vbTextCompare) = 1 Then
                docdapan = Chr(64 + i)
                Exit For
            End If
        End If
     
    Next i

End Function
 

tuhocvba

Administrator
Thành viên BQT
Hôm nay tôi đã phát hành bản demo 1.0:
Bạn cần đăng nhập để thấy đa phương tiện
 

tuhocvba

Administrator
Thành viên BQT
Chúng ta thử phân tích thủ tục taodethi trong file Database:
Bạn cần đăng nhập để thấy đính kèm

Phần màu xanh ở phía trên là thủ tục tạo đề thi ở chế độ ngẫu nhiên khó.
Phần màu vàng là sắp xếp câu hỏi ngẫu nhiên theo mức độ từ dễ tới khó.
 

tuhocvba

Administrator
Thành viên BQT
Ở phần trên, hai thủ tục nhatcauhoi đi theo hai logic như mình trình bày, thủ tục taofiletexdethi là phần chung.
Dưới đây là bảng tổng hợp số lượng code trên file Database tính tới thời điểm hiện tại:
Bạn cần đăng nhập để thấy đính kèm
 

tuhocvba

Administrator
Thành viên BQT
Bản 1.1.1 phát hành . Do không biết tới cấu trúc latex của hệ phương trình, tôi đã gặp khó khăn , logic đếm dấu ngoặc {} tưởng là đổ vỡ nhưng cuối cùng đã kịp fix xong .

 

tuhocvba

Administrator
Thành viên BQT
Thật là phiền hà rắc rối khi mà bên word lại có một định nghĩa ID với cách ghi khác. Nếu không thống nhất, cứ mỗi người một phách thế này, quả thực rất mệt. Thể theo nguyện vọng của một bạn, mình viết hàm chuyển đổi ID trên Excel.
Mã:
'[1D3-2.4-3]: đại số 11 chương 3. bài 2. dạng 4. mức độ 3 hả
'1D3K2-4
'2.4 => 2-4
'1=>Y
'2=>B
'3=>K
'4=>G
'5=>T
Private Function cidw6(ByVal rng As Range) As String
    Dim kq As String, s As String
   
    On Error GoTo thoat
        s = rng.Value
        kq = chuyenidw(s) 'Lay cac ky tu [....]
        'Chuyen thanh id6
        kq = chuyenidw6(kq)
    cidw6 = kq
thoat:
    Err.Clear
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)
   
    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
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 = "]"
   
    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
 

tuhocvba

Administrator
Thành viên BQT
Rạng sáng nay Tool Ex Test v1.2 Final đã phát hành. Tôi sẽ dừng dự án này tại đây để tập trung cho công việc của mình.
Bạn cần đăng nhập để thấy đa phương tiện
 

tuhocvba

Administrator
Thành viên BQT
Tôi nghĩ rằng khi chúng ta làm điều tốt thì sẽ nhận lại những điều tốt đẹp. Hôm qua có 2 việc tình cờ.
Một là, tình cờ video của thầy HungChau trên nhóm Toán và Latex đã giúp tôi hiểu rằng \% là ký tự % .
Hai là, tôi gửi link topic này cho thầy MinhKhai tham khảo, vô tình đọc lại nội dung topic thì thấy xử lý của tôi sẽ gặp rắc rối lớn.
Cụ thể là:

Mã:
Function tachlayloigiai(s As String)
Hiện tại chức năng đọc và đảo đáp án phụ thuộc vào hàm này. Logic của hàm là sẽ loại bỏ các ký tự vô nghĩa, tức là các ký tự sau dấu %.

Như vậy nếu một câu hỏi mà có các đáp án là:
3% hay 5% hay 15% thì sẽ bị ảnh hưởng bởi logic hiện tại.

Có lẽ do chương trình toán phổ thông cũng ít dùng dấu %, nó thường xuất hiện ở môn Hóa hơn, cho nên bấy lâu nay test rất nhiều file mà không ai phản hồi có lỗi này.

Để xử lý lỗi trên tôi sẽ không đi vào logic bên trong, mà sẽ can thiệp từ bên ngoài. Cụ thể là:

Tôi sẽ tìm các ký tự \% có trong s và thay thế nó thành một ký tự đặc biệt, chả hạn là @phantram@. Mục đích là sẽ không còn có dấu % như vừa rồi gây nhiễu nữa. Sau khi xử lý xong, trước khi đưa ra output cuối cùng tới người dùng, tôi sẽ phải chuyển lại @phantram@ thành dấu \%. Như vậy là ổn thỏa.
 
Top