SodokuX nhờ Copilot trợ giúp (2 người xem)

[SA_DQ]

Đây rồi, bản mô tả luật SudokuX ngắn gọn – súc tích – dễ đăng ngay lên diễn đàn Excel:
SudokuX – Luật chơi

• SudokuX giữ nguyên luật Sudoku truyền thống: mỗi hàng, mỗi cột, và mỗi ô 3×3 phải chứa đủ các số từ 1 đến 9, không trùng lặp.
• Điểm khác biệt duy nhất: hai đường chéo (chính và phụ) được cố định bằng hai chuỗi ngẫu nhiên không trùng nhau.
• Người chơi phải hoàn thiện phần còn lại của bàn Sudoku trong điều kiện ràng buộc này.

Tóm gọn: SudokuX = Sudoku truyền thống + hai đường chéo ngẫu nhiên.

Lời mời thách thức​

SudokuX – biến thể mới dành cho những bộ óc mê logic!Hai đường chéo đã được khóa bằng chuỗi ngẫu nhiên.Bạn có dám chinh phục thử thách này không?

Với cách viết này, bạn vừa có phần luật rõ ràng, vừa có phần giới thiệu hấp dẫn để thu hút người chơi.

Bài đã được tự động gộp: 3/3/26

Mình sẽ cho bạn một đoạn VBA solver đơn giản để kiểm tra xem bàn Sudoku (bao gồm cả SudokuX) có nghiệm hay không. Đây là dạng backtracking cơ bản – duyệt từng ô trống, thử điền số từ 1 đến 9, và kiểm tra hợp lệ. Nếu hợp lệ thì tiếp tục, nếu không thì quay lui.

VBA Solver cơ bản cho Sudoku​

Option Explicit
Const N = 9
Dim board(1 To N, 1 To N) As Integer
' Kiểm tra số có hợp lệ tại vị trí (row, col)  '
Function IsValid(row As Integer, col As Integer, num As Integer) As Boolean
    Dim i As Integer, j As Integer
    ' Kiểm tra hàng '
    For i = 1 To N
        If board(row, i) = num Then IsValid = False: Exit Function
    Next i
    ' Kiểm tra cột  '
    For i = 1 To N
        If board(i, col) = num Then IsValid = False: Exit Function
    Next i
    ' Kiểm tra ô 3x3 '
    Dim startRow As Integer, startCol As Integer
    startRow = ((row - 1) \ 3) * 3 + 1
    startCol = ((col - 1) \ 3) * 3 + 1
    For i = 0 To 2
        For j = 0 To 2
            If board(startRow + i, startCol + j) = num Then IsValid = False: Exit Function
        Next j
    Next i
    IsValid = True
End Function

' Hàm giải Sudoku bằng backtracking  '
Function SolveSudoku() As Boolean
    Dim row As Integer, col As Integer, num As Integer
    For row = 1 To N
        For col = 1 To N
            If board(row, col) = 0 Then ' ô trống  '
                For num = 1 To N
                    If IsValid(row, col, num) Then
                        board(row, col) = num
                        If SolveSudoku() Then
                            SolveSudoku = True
                            Exit Function
                        End If
                        board(row, col) = 0 ' quay lui  '
                    End If
                Next num
                SolveSudoku = False
                Exit Function
            End If
        Next col
    Next row
    SolveSudoku = True ' tất cả ô đã điền  '
End Function

Cách dùng​

1. Bạn nhập bàn Sudoku vào mảng board(1 To 9, 1 To 9).
   • Dùng số 0 cho ô trống.
   • Điền sẵn hai đường chéo ngẫu nhiên theo quy tắc SudokuX.
2. Gọi SolveSudoku().
   • Nếu trả về True → bàn có nghiệm.
   • Nếu trả về False → bàn vô nghiệm.
3. Sau khi chạy, mảng board sẽ chứa lời giải.

Lưu ý:

• Đoạn solver này chỉ kiểm tra có nghiệm hay không, chưa kiểm tra nghiệm duy nhất.
• Muốn kiểm tra nghiệm duy nhất, bạn cần sửa solver để đếm số nghiệm (ví dụ: tăng biến đếm mỗi khi tìm thấy lời giải, nếu >1 thì bàn có nhiều nghiệm).

Bạn có muốn mình mở rộng đoạn solver này thành phiên bản đếm số nghiệm để bạn biết bàn SudokuX có duy nhất một lời giải hay nhiều lời giải không?

 

[HieuCD]

Đây rồi, bản mô tả luật SudokuX ngắn gọn – súc tích – dễ đăng ngay lên diễn đàn Excel:
SudokuX – Luật chơi

• SudokuX giữ nguyên luật Sudoku truyền thống: mỗi hàng, mỗi cột, và mỗi ô 3×3 phải chứa đủ các số từ 1 đến 9, không trùng lặp.
• Điểm khác biệt duy nhất: hai đường chéo (chính và phụ) được cố định bằng hai chuỗi ngẫu nhiên không trùng nhau.
• Người chơi phải hoàn thiện phần còn lại của bàn Sudoku trong điều kiện ràng buộc này.

Tóm gọn: SudokuX = Sudoku truyền thống + hai đường chéo ngẫu nhiên.

Lời mời thách thức​

SudokuX – biến thể mới dành cho những bộ óc mê logic!Hai đường chéo đã được khóa bằng chuỗi ngẫu nhiên.Bạn có dám chinh phục thử thách này không?

Với cách viết này, bạn vừa có phần luật rõ ràng, vừa có phần giới thiệu hấp dẫn để thu hút người chơi.

Bài đã được tự động gộp: 3/3/26

Mình sẽ cho bạn một đoạn VBA solver đơn giản để kiểm tra xem bàn Sudoku (bao gồm cả SudokuX) có nghiệm hay không. Đây là dạng backtracking cơ bản – duyệt từng ô trống, thử điền số từ 1 đến 9, và kiểm tra hợp lệ. Nếu hợp lệ thì tiếp tục, nếu không thì quay lui.

VBA Solver cơ bản cho Sudoku​

Option Explicit
Const N = 9
Dim board(1 To N, 1 To N) As Integer
' Kiểm tra số có hợp lệ tại vị trí (row, col)  '
Function IsValid(row As Integer, col As Integer, num As Integer) As Boolean
    Dim i As Integer, j As Integer
    ' Kiểm tra hàng '
    For i = 1 To N
        If board(row, i) = num Then IsValid = False: Exit Function
    Next i
    ' Kiểm tra cột  '
    For i = 1 To N
        If board(i, col) = num Then IsValid = False: Exit Function
    Next i
    ' Kiểm tra ô 3x3 '
    Dim startRow As Integer, startCol As Integer
    startRow = ((row - 1) \ 3) * 3 + 1
    startCol = ((col - 1) \ 3) * 3 + 1
    For i = 0 To 2
        For j = 0 To 2
            If board(startRow + i, startCol + j) = num Then IsValid = False: Exit Function
        Next j
    Next i
    IsValid = True
End Function

' Hàm giải Sudoku bằng backtracking  '
Function SolveSudoku() As Boolean
    Dim row As Integer, col As Integer, num As Integer
    For row = 1 To N
        For col = 1 To N
            If board(row, col) = 0 Then ' ô trống  '
                For num = 1 To N
                    If IsValid(row, col, num) Then
                        board(row, col) = num
                        If SolveSudoku() Then
                            SolveSudoku = True
                            Exit Function
                        End If
                        board(row, col) = 0 ' quay lui  '
                    End If
                Next num
                SolveSudoku = False
                Exit Function
            End If
        Next col
    Next row
    SolveSudoku = True ' tất cả ô đã điền  '
End Function

Cách dùng​

1. Bạn nhập bàn Sudoku vào mảng board(1 To 9, 1 To 9).
   • Dùng số 0 cho ô trống.
   • Điền sẵn hai đường chéo ngẫu nhiên theo quy tắc SudokuX.
2. Gọi SolveSudoku().
   • Nếu trả về True → bàn có nghiệm.
   • Nếu trả về False → bàn vô nghiệm.
3. Sau khi chạy, mảng board sẽ chứa lời giải.

Lưu ý:

• Đoạn solver này chỉ kiểm tra có nghiệm hay không, chưa kiểm tra nghiệm duy nhất.
• Muốn kiểm tra nghiệm duy nhất, bạn cần sửa solver để đếm số nghiệm (ví dụ: tăng biến đếm mỗi khi tìm thấy lời giải, nếu >1 thì bàn có nhiều nghiệm).

Bạn có muốn mình mở rộng đoạn solver này thành phiên bản đếm số nghiệm để bạn biết bàn SudokuX có duy nhất một lời giải hay nhiều lời giải không?

Thuật toán đệ quy nầy chạy hơi bị mệt và dể đứng máy.
Viết lại code theo thuật toán vét cạn để đếm số nghiệm
- Dữ liệu đầu vào nhập vào vùng: "B2:J10"
- Do khối lượng xử lý rất lớn nên thời gian chạy code rất lâu
_ Nếu muốn dừng code theo giới hạn thời gian thì cho chạy dòng lệnh: If Timer - now >= 100 Then ....
bằng cách bỏ dấu nháy ' trước dòng lệnh, và có thể chỉnh tăng giảm số "100"

Sub Main()
  Dim arr(), a&(1 To 81, 1 To 3), t
  Dim i&, j&, N&, fN&, sR&, D&, now

  fN = 1:     now = Timer
  arr = Range("B2:J10").Value
  For i = 1 To 9 ' Tao mang vi tri cac o rong can dien so
    For j = 1 To 9
      If arr(i, j) = Empty Then
        sR = sR + 1:      a(sR, 1) = i:     a(sR, 2) = j
      End If
    Next j
  Next i
  For i = 1 To sR
    For N = fN To 9
      If Trung(arr, a, N, a(i, 1), a(i, 2)) = False Then
        fN = 1:        a(i, 3) = N:      arr(a(i, 1), a(i, 2)) = N
        Exit For
      End If
    Next N
    If N = 10 And i = 1 Then 'Chay xong
      Range("K1") = D
      Range("B12:J20").Value = t 'Mang ket qua
      MsgBox ("Mung qua! code da chay xong!")
      Exit Sub
    ElseIf N = 10 Or i = sR Then
      If i = sR Then 'Ket qua thoa dieu kien
        t = arr:         D = D + 1
        arr(a(i, 1), a(i, 2)) = Empty 'Tiep tuc xet mang ket qua ke tiep
      End If
      arr(a(i - 1, 1), a(i - 1, 2)) = Empty
      fN = a(i - 1, 3) + 1:       i = i - 2
    End If
    'If Timer - now >= 100 Then MsgBox ("Het thoi gian cho phep chay code!"): Exit Sub
  Next i
End Sub

Private Function Trung(arr, a, N, ByVal k&, ByVal c&) As Boolean
  Dim i&, j&, m&, fR&, eR&, fC&, eC&
  fR = Int((k - 1) / 3) * 3 + 1:      eR = fR + 2
  fC = Int((c - 1) / 3) * 3 + 1:      eC = fC + 2
  For i = fR To eR
    For j = fC To eC
      m = m + 1
      If arr(i, j) = N Or arr(m, c) = N Or arr(k, m) = N Then Trung = True: Exit Function
    Next j
  Next i
End Function