Tạo Câu hỏi ngẫu nhiên và các lựa chọn đáp án ngẫu nhiên?

[thkd09]

Chào các bác!
Em đang làm một tiện ích trắc nghiệm, Em đã có 1 bảng dữ liệu gồm Câu hỏi và 4 sự lựa chọn đáp án.
Bây giờ em muốn:
1. Lấy ra 10 câu hỏi ngẫu nhiên trong bảng dữ liệu.
2. Các phương án trả lời cũng lấy ngẫu nhiên theo câu hỏi (tức là em muốn đổi vị trí các phương án trả lời)
Kính mong các bác hướng dẫn giúp em ạ. Em xin chân thành cảm ơn!

 

[HieuCD]

Em gửi anh file đã bỏ macro. Em quên không nói là vẫn trộn đảo cả đáp án giống như code anh đã làm nhé!

Chỉnh đáp án đúng mới do đã trộn đáp án
res(k, 7) = b(arr(a(i), 7)) 'Chinh dap an dung

Option Explicit
Sub XYZ()
  Dim aCon(), S, aCol, arr(), a&(), b&(), res(), sh As Worksheet
  Dim r&, i&, k&, j&, SoCau
 
  aCol = Array(1, 2, 8, 9, 10)
  ReDim res(1 To 500, 1 To 10) 'Toi da 500 cau
  With Sheets("Config")
    aCon = .Range("G2", .Range("H" & Rows.Count).End(xlUp)).Value
  End With
  Randomize
  On Error Resume Next
  For r = 1 To UBound(aCon)
    SoCau = aCon(r, 2)
    If IsNumeric(SoCau) And SoCau > 0 Then
      S = Split(aCon(r, 1), " ")
      Set sh = Sheets(S(UBound(S)))
      If Err.Number = 0 Then
        arr = sh.Range("A4", sh.Range("J" & Rows.Count).End(xlUp)).Value
        Call TaoMangNgauNhien(a, UBound(arr))
        If SoCau > UBound(arr) Then SoCau = UBound(arr) 'Gioi han so cau tung sheet
        For i = 1 To SoCau
          k = k + 1
          For j = 0 To UBound(aCol)
            res(k, aCol(j)) = arr(a(i), aCol(j))
          Next j
          Call TaoMangNgauNhien(b, 4)
          For j = 1 To 4
            res(k, b(j) + 2) = arr(a(i), j + 2)
          Next j
          res(k, 7) = b(arr(a(i), 7)) 'Chinh dap an dung
        Next i
      Else
        Err.Number = 0
      End If
    End If
  Next r
  With Sheets("TronCauHoi")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:J" & i).ClearContents
    If k Then .Range("A2").Resize(k, 10) = res
  End With
End Sub

Sub TaoMangNgauNhien(aRnd, N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

 

[toangm]

Chỉnh đáp án đúng mới do đã trộn đáp án
res(k, 7) = b(arr(a(i), 7)) 'Chinh dap an dung

Option Explicit
Sub XYZ()
  Dim aCon(), S, aCol, arr(), a&(), b&(), res(), sh As Worksheet
  Dim r&, i&, k&, j&, SoCau
 
  aCol = Array(1, 2, 8, 9, 10)
  ReDim res(1 To 500, 1 To 10) 'Toi da 500 cau
  With Sheets("Config")
    aCon = .Range("G2", .Range("H" & Rows.Count).End(xlUp)).Value
  End With
  Randomize
  On Error Resume Next
  For r = 1 To UBound(aCon)
    SoCau = aCon(r, 2)
    If IsNumeric(SoCau) And SoCau > 0 Then
      S = Split(aCon(r, 1), " ")
      Set sh = Sheets(S(UBound(S)))
      If Err.Number = 0 Then
        arr = sh.Range("A4", sh.Range("J" & Rows.Count).End(xlUp)).Value
        Call TaoMangNgauNhien(a, UBound(arr))
        If SoCau > UBound(arr) Then SoCau = UBound(arr) 'Gioi han so cau tung sheet
        For i = 1 To SoCau
          k = k + 1
          For j = 0 To UBound(aCol)
            res(k, aCol(j)) = arr(a(i), aCol(j))
          Next j
          Call TaoMangNgauNhien(b, 4)
          For j = 1 To 4
            res(k, b(j) + 2) = arr(a(i), j + 2)
          Next j
          res(k, 7) = b(arr(a(i), 7)) 'Chinh dap an dung
        Next i
      Else
        Err.Number = 0
      End If
    End If
  Next r
  With Sheets("TronCauHoi")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:J" & i).ClearContents
    If k Then .Range("A2").Resize(k, 10) = res
  End With
End Sub

Sub TaoMangNgauNhien(aRnd, N)
  Dim i&, t&, r&
  ReDim aRnd(1 To N)
  For i = 1 To N
    r = Int(Rnd * N) + 1
    If aRnd(r) = 0 Then t = r Else t = aRnd(r)
    If aRnd(N) = 0 Then aRnd(r) = N Else aRnd(r) = aRnd(N)
    aRnd(N) = t
    N = N - 1
  Next i
End Sub

Cảm ơn anh! Anh code còn mở rộng hơn em tưởng tượng nhiều, em kế thừa nhiều cái tinh hoa trong code của anh, giúp em giảm thiểu code trước đây em đã làm mất thời gian. Một lần nữa xin cảm ơn anh!