Giải Sudoku bằng VBA

tuhocvba · 18/10/19

==========
PHẦN 3: Các phương án giải (tiếp theo)
==========
Phương án giải số 3.1: Giải theo hàng
(tiếp theo)
Biến cách nghĩ thành hình ảnh trực quan:

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

Thời điểm gọi phương án giải số 3.1:
Ta đang đứng ở cells(r,c) trong ô vuông 9x9, đó là các ô được tô màu vàng dưới đây. Từ đó ta gọi phương án giải số 3.1 ra giải quyết.

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

Như vậy điều kiện để gọi phương án giải số 3.1 là c=1.
Kiểm tra trước đó:

Nếu như trong hàng không còn cells trống nào thì kết thúc.
Nếu như trong hàng còn cells trống thì cần gọi phương án giải số 3.1

Quá trình kiểm tra:
Ta kiểm tra lần lượt từ hàng 1 tới hàng 9, xem có số nào chưa tồn tại trong hàng hay không. Nếu chưa tồn tại thì số đó là ứng cử viên đáp án cho hàng đó.

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

Trong đó, cấm chỉ việc một số lặp lại trong cùng hàng hay cột, hay trong khu vực ô vuông 3x3. Điều này thì cũng giống như phương án giải số 2.
Ví dụ khi ta xét ô A1. Thì các khu vực không được lặp lại số là phần tô màu vàng hồng.

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

Tên biến số	Kiểu dữ liệu	Định nghĩa
SetCnt	Long	Đếm số ô cells có khả năng điền đáp án
x	Long	Lưu cột của cells có khả năng điền đáp án

SetCnt sẽ tăng lên 1 nếu ta tìm thấy một ô cells có khả năng điền đáp án.
Vì vậy:
Nếu SetCnt >1 thì không thể quyết định được gì.
Nếu SetCnt = 1 thì ta quyết định được đáp án.

Euler · 19/10/19

==========
PHẦN 3: Các phương án giải (tiếp theo)
==========
Phương án giải số 3.1: Giải theo hàng
(tiếp theo)
Flowchart:

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

Xây dựng chương trình:
Xử lý gọi phương án giải 3.1:

Mã:

If c = 1 Then Call Solution3_Row

Từ vị trí cells hiện tại trong ô vuông 9x9, ta sẽ kiểm tra nếu cột của cells ấy là 1 thì sẽ tiến hành gọi thủ tục phương án giải 3.1 có tên là Solution3_Row ra giải quyết.

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

Xử lý bên trong của phương án giải 3.1:

Trong hàng chứa cells đang xét, có tồn tại cells rỗng nào không?

Mã:

If WorksheetFunction.CountBlank(Range(Cells(r, 1), Cells(r, 9))) = 0 Then
    Exit Sub
End If

Nếu không tồn tại cells rỗng nào, đương nhiên sẽ cho kết thúc ngay (Exit Sub).

Vòng lặp Loop 1: Kiểm tra các số num=1~9.
Trong hàng chứa cells đang xét, có tồn tại số num hay không?

Mã:

If isExistNum(r, 1, r, 9) = False Then
    '～Xử lý～
End If

Vòng lặp Loop 2: Kiểm tra các cột 1~9, cells là rỗng hay không?

Mã:

Dim i As Long
For i = 1 To 9 'Chạy từ cột 1 đến cột 9
                
    If Cells(r, i).Value = "" Then
        '～Xử lý～
    End If
                
Next i

Ở đây có điểm chú ý: hàng r thì ta sẽ dùng biến public. Cột của ô thì ta dùng biến local i.

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

Chỉ định khối BlockArea

Mã:

Dim c2 As Long 'Phương án giải 3.1: Cột của cells bắt đầu của khối BlockArea
c2 = SearchBlockArea(i)

Ở đây có điểm chú ý:
Phương án giải 1 và phương án giải 2 thì không dùng xử lý chỉ định BlockArea mà sử dụng các biến public r1,c1.
Phương án giải 3.1 sẽ sử dụng biến public r1 là hàng của cells bắt đầu của khối BlockArea.
Phương án giải 3.1 sử dụng biến local c2 là cột của cells bắt đầu của khối BlockArea.
Ví dụ:
cells trống ① thì có vùng BlockArea là Range(Cells(1, 1), Cells(3, 3)).
cells trống ② thì có vùng BlockArea là Range(Cells(1, 4), Cells(3, 6)).

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

Trong phương án giải 3.1 thì cột luôn biến động, vì vậy mà vị trí của khối BlockArea cũng bị biến động theo.
Do đó vị trí cột của cells bắt đầu của khối BlockArea cần chúng ta chỉ định. Còn hàng r thì bị cố định, cho nên ta có thể dùng biến public r1.

Tìm kiếm 1: Trong cùng cột, số num có tồn tại hay không?
Tìm kiếm 2: Trong khối BlockArea tương ứng, số num có tồn tại hay không?

Mã:

Dim check1 As Boolean, check2 As Boolean
check1 = isExistNum(1, i, 9, i) 'Kiểm tra cột
check2 = isExistNum(r1, c2, r1 + 2, c2 + 2) 'Kiểm tra BlockArea

Tìm kiếm 1 và Tìm kiếm 2 đều cho kết quả là chưa tồn tại:

Mã:

If check1 = False And check2 = False Then
    '～Xử lý～                   
End If

Tăng biến SetCnt và lưu giá trị cột của cells khi thấy có khả năng là đáp án.

Mã:

Dim SetCnt As Long
SetCnt = SetCnt + 1 'Số lượng cells có thể điền số num
                        
Dim x As Long
x = i 'Vị trí cột của cells hiện tại

Nếu SetCnt=1 thì đó là đáp án.

Mã:

If SetCnt = 1 Then Call AnswerSet(r, x, num)

Reset lại biến SetCnt

Mã:

SetCnt = 0

Tóm lại code cho phương án giải số 3.1 là:
Phần module chung:

Mã:

For r = 1 To 9
    For c = 1 To 9
    
        'Chỉ định cells bắt đầu cho BlockArea
        r1 = SearchBlockArea(r)
        c1 = SearchBlockArea(c)
        
        'Gọi phương án giải số 1
        If Cells(r, c).Value = "" Then Call Solution1
        
        'Gọi phương án giải số 2
        If (r = 1 Or r = 4 Or r = 7) And (c = 1 Or c = 4 Or c = 7) Then Call Solution2
        
        'Gọi phương án giải 3.1
        If c = 1 Then Call Solution3_Row

    Next c
Next r

Module phương án giải 3 (3.1)

Mã:

Sub Solution3_Row()

    If WorksheetFunction.CountBlank(Range(Cells(r, 1), Cells(r, 9))) = 0 Then
        Exit Sub
    End If

    For num = 1 To 9
    
        'Bắt đầu kiểm tra xem trong hàng có số num chưa?
        If isExistNum(r, 1, r, 9) = False Then

            Dim i As Long
            For i = 1 To 9 'Chạy từ cột 1 tới cột 9
                
                If Cells(r, i).Value = "" Then
                
                    Dim c2 As Long 'Chỉ định BlockArea
                    c2 = SearchBlockArea(i)
                
                    Dim check1 As Boolean, check2 As Boolean
                    check1 = isExistNum(1, i, 9, i) 'Kiểm tra cột
                    check2 = isExistNum(r1, c2, r1 + 2, c2 + 2) 'Kiểm tra BlockArea
                    
                    'Nếu chưa tồn tại num thì
                    If check1 = False And check2 = False Then
                        
                        Dim SetCnt As Long, x As Long
                        SetCnt = SetCnt + 1 'Đếm số lượng cells có khả năng điền num
                        x = i 'Lưu cột của cells hiện tại
                        
                    End If
                
                End If
                
            Next i
            
            'Ghi đáp án
            If SetCnt = 1 Then Call AnswerSet(r, x, num)
            
            SetCnt = 0 'reset về ban đầu

        End If

    Next num

End Sub

giaiphapvba · 30/10/19

==========
PHẦN 3: Các phương án giải (tiếp theo)
==========
Phương án giải số 3.2: Giải theo cột
Ở phương án giải số 3.2 ta sử dụng các biến số sau:

Tên biến số	Kiểu dữ liệu	Định nghĩa
PuzzleArea	Range	Ô vuông lớn 9x9
BlockArea	Range	Ô vuông nhỏ 3x3 PuzzleArea
r	Long	Hàng trong ô vuông 9x9
c	Long	Cột trong ô vuông 9x9
r1	Long	Hàng của cells bắt đầu trong khối BlockArea
c1	Long	Cột của cells bắt đầu trong khối BlockArea
num	Long	Số từ 1 đến 9

Phương án giải số 3.2: Giải theo cột

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

Ở đây tôi sẽ thuyết minh cột đầu tiên làm ví dụ, các cột khác sẽ tương tự.
Từ luật điền số ta nhận thấy rằng số 1 chỉ có thể điền vào ô A1 mà thôi.
Về phạm vi của phương án 3.2 là cột, còn phạm vi của phương án 3.1 là hàng, hai phương án này chỉ khác nhau phạm vi giải mà thôi, còn cách nghĩ thì hoàn toàn tương tự.
Phương án 3.1 sẽ giải từng hàng, còn phương án 3.2 sẽ giải từng cột.

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

Làm nổi bật cách nghĩ bằng hình ảnh:
Sau đây chúng ta sẽ cùng nhau làm nổi bật cách nghĩ phương án giải 3.2 bằng hình ảnh.
Thời điểm gọi phương án giải 3.2:
Giả sử cells ta đang đứng là cells(r,c) là một cells bất kỳ ở hàng thứ nhất, tại đây ta sẽ gọi phương án giải 3.2 tương ứng với cột c.

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

Như vậy điều kiện để ta gọi phương án giải 3.2 ra giải quyết là r=1.
Kiểm tra trước khi giải:

Nếu cột không có cells rỗng nào thì kết thúc.
Nếu tồn tại cells rỗng thì tiến hành kiểm tra.

Kiểm tra:
Ta sẽ kiểm tra lần lượt các số từ 1 đến 9 xem trong cột đã tồn tại hay chưa, nếu chưa tồn tại thì ta sẽ tiến hành xem chúng có thể được điền vào ô trống nào trong cột.

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

Ở đây có luật:

Trong cùng hàng đã tồn tại số đó chưa?
Trong khối 3x3 chứa ô trống đã tồn tại số đó chưa?

Ví dụ trong trường hợp ví dụ này thì số 1 chỉ có thể điền vào A1 mà thôi.

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

Tương tự như phương án giải 3.1 ta cũng có:

Tên biến	Kiểu dữ liệu	Định nghĩa
SetCnt	Long	Đếm số lượng cells có thể điền số vào đó
y	Long	Lưu hàng của ô có thể điền số vào

Biến SetCnt sẽ tăng 1 đơn vị mỗi khi tìm thấy cells trống có thể điền số vào.
Phán đoán đáp số:

Nếu SetCnt=1 thì đi tới quyết định đáp án.
Nếu SetCnt>1 thì không đi tới quyết định đáp án.

tuhocvba · 23/11/19

==========
PHẦN 4: Tổng kết
==========
Phương án giải số 1: Chúng ta duyệt từng cells trống xem đáp án điền vào đó là số nào.

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

Phương án giải số 2: Chúng ta giải ô vuông 3x3. Số nào chưa tồn tại trong khối 3x3, và số ấy có thể điền vào ô trống nào trong khối 3x3.

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

Phương án giải số 3(theo hàng và theo cột): Chúng ta duyệt từng hàng (cột) xem số nào chưa tồn tại trong hàng (cột), và số ấy có thể điền vào ô trống nào trong hàng (cột).

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

Cấu trúc code:

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

Euler · 23/11/19

==========
PHẦN 4: Tổng kết
==========
(Tiếp theo 1)
Code cho Module chung:

Mã:

Option Explicit

Public r As Long, c As Long 'Dòng và cột của cells hiện tại
Public r1 As Long, c1 As Long 'Dòng và cột của cells bắt đầu của khối BlockArea
Public num As Long 'Số từ 1~9

Sub VBA_solution'Lời giải tổng thể

    Application.ScreenUpdating = False

    Dim PuzzleArea As Range
    Set PuzzleArea = Range("A1:I9")
    
    Do 'Bắt đầu Loop 1
    
        Dim BlankCnt1 As Long 'Số cells rỗng trước khi bắt đầu Loop 2
        BlankCnt1 = WorksheetFunction.CountBlank(PuzzleArea)

        For r = 1 To 9 'Bắt đầu Loop 2
            For c = 1 To 9
            
                'Cells bắt đầu của khối BlockArea
                r1 = SearchBlockArea(r)
                c1 = SearchBlockArea(c)
                
                'Gọi lời giải 1
                If Cells(r, c).Value = "" Then Call Solution1
                
                'Gọi lời giải 2
                If (r = 1 Or r = 4 Or r = 7) And _
                    (c = 1 Or c = 4 Or c = 7) Then Call Solution2
            
                'Gọi lời giải 3 theo hàng
                If c = 1 Then Call Solution3_Row
                
                'Gọi lời giải 3 theo cột
                If r = 1 Then Call Solution3_Col

            Next c
        Next r
        
        Dim BlankCnt2 As Long 'Số cells rỗng sau khi Loop 2 kết thúc
        BlankCnt2 = WorksheetFunction.CountBlank(PuzzleArea)
        
        If BlankCnt1 = BlankCnt2 Then
            MsgBox "Chuong trinh chiu thua"
            Exit Sub
        End If
    
    Loop Until WorksheetFunction.CountBlank(PuzzleArea) = 0
    
End Sub

Function SearchBlockArea(x As Long) As Long
'-------------------------------------------------------------------
' * Chức năng：Thiet dinh cells bắt đầu của khối BlockArea(3×3)
' * Tham só：Dong va cot cua cells hien tai (r) ,(c)
' * Giá trị trả về：Donngg va cot cua cell bat dau cua khoi BlockArea
'-------------------------------------------------------------------

    Select Case x
        
        Case 1, 4, 7
            SearchBlockArea = x
        Case 2, 5, 8
            SearchBlockArea = x - 1
        Case 3, 6, 9
            SearchBlockArea = x - 2

    End Select

End Function

Function isExistNum _
    (ByVal y1 As Long, x1 As Long, y2 As Long, x2 As Long) As Boolean
' --------------------------------------------------------------------------
' * Chức năng：Trong phạm vi được chỉ định thì số num tồn tại hay không?
' * Tham só：Dong, cot cua cells bat dau và dong, cot cua cells kết thúc
' * Giá trị trả vè：True nếu số num tồn tại
' --------------------------------------------------------------------------

    Dim result As Range
    Set result = Range(Cells(y1, x1), Cells(y2, x2)). _
                            Find(what:=num, LookAt:=xlWhole)
    
    'num được tìm thấy thì giá trị trả về là True
    If Not result Is Nothing Then isExistNum = True

End Function

Sub AnswerSet(ByVal y As Long, x As Long, answer As Long)
' ------------------------------------------------------------------
' * Chức năng：ghi đáp án vào cells được chỉ định
' * Tham só：Dong, cot cua cells se ghi dap an, va dap an
' ------------------------------------------------------------------

    With Cells(y, x)
        .Value = answer
        .Font.Bold = True 'tô đậm
        .Font.ColorIndex = 3 'màu đỏ
    End With
    
End Sub

vbano1 · 23/11/19

==========
PHẦN 4: Tổng kết
==========
(Tiếp theo 2)
Code cho Module1-Phương án giải 1

Mã:

Option Explicit
Option Base 1

Sub Solution1()

    Dim CheckFlag(9) As Boolean

    For num = 1 To 9 'Loop 1
        
        Dim check1 As Boolean, check2 As Boolean, check3 As Boolean
        
        check1 = isExistNum(r1, c1, r1 + 2, c1 + 2) '① Tìm trong BlockArea
        check2 = isExistNum(r, 1, r, 9) '②Tim theo phuong ngang  (dòng)
        check3 = isExistNum(1, c, 9, c) '③ Tim theo phuong dung (cột)
        
        'Lần lượt các tìm kiếm  ①②③ mà thấy num thì giá trị trả về là True
        If check1 = True Or check2 = True Or check3 = True Then
            CheckFlag(num) = True
        End If
    
    Next num

    For num = 1 To 9 'Loop 2
    
        If CheckFlag(num) = False Then
        
            Dim cnt As Long 'Đếm số lượng False
            cnt = cnt + 1
            
            Dim answer As Long 'Ứng cử viên đáp án
            answer = num
        
        End If
    
    Next num
    
    If cnt = 1 Then 'Ghi đáp án vào cells
        Call AnswerSet(r, c, answer)
    End If
    
End Sub

giaiphapvba · 23/11/19

==========
PHẦN 4: Tổng kết
==========
(Tiếp theo 3)
Code cho Module2-Phương án giải 2

Mã:

Option Explicit
Option Base 1

Sub Solution2()

    Dim BlockArea As Range
    Set BlockArea = Range(Cells(r1, c1), Cells(r1 + 2, c1 + 2))
   
    'Nếu ô vuông 3×3 đã hoàn thành thì phương án giải 2 không cần thiết
    If WorksheetFunction.CountBlank(BlockArea) = 0 Then Exit Sub

    For num = 1 To 9
   
        'Số num chưa tồn tại trong BlockArea(3×3), thì bắt đầu
        If isExistNum(r1, c1, r1 + 2, c1 + 2) = False Then
           
            Dim cell As Range
            For Each cell In BlockArea 'Chạy hết các cells
           
                If cell.Value = "" Then
               
                    Dim check1 As Boolean, check2 As Boolean
                    check1 = isExistNum(cell.Row, 1, cell.Row, 9) '① Tìm kiếm theo hàng
                    check2 = isExistNum(1, cell.Column, 9, cell.Column) '② Tìm kiếm theo cột
           
                    'num nếu không tồn tại trong hàng và cột:
                    If check1 = False And check2 = False Then
           
                        Dim SetCnt As Long
                        SetCnt = SetCnt + 1 'Số lượng cells có thể là đáp án
                       
                        Dim y As Long, x As Long
                        y = cell.Row 'Dòng của cells hiện tại
                        x = cell.Column 'Cột của cells hiện tại
                   
                    End If
           
                End If
           
            Next
           
            If SetCnt = 1 Then Call AnswerSet(y, x, num)
           
            SetCnt = 0 'Sang số num tiếp theo
           
        End If
   
    Next num
   
End Sub

vbano1 · 23/11/19

==========
PHẦN 4: Tổng kết
==========
(Tiếp theo 4)
Code cho Module3-Phương án giải 3

Mã:

Option Explicit

Sub Solution3_Row()

    'Nếu hàng đã giải quyết xong thì không cần giải nữa
    If WorksheetFunction.CountBlank(Range(Cells(r, 1), Cells(r, 9))) = 0 Then
        Exit Sub
    End If

    For num = 1 To 9
   
        'Bắt đầu kiểm tra xem num tồn tại trong hàng hay chưa thì tiến hành giải
        If isExistNum(r, 1, r, 9) = False Then

            Dim i As Long
            For i = 1 To 9 'Kiểm tra tuần tự các cột từ 1 đến 9
               
                If Cells(r, i).Value = "" Then
               
                    Dim c2 As Long
                    c2 = SearchBlockArea(i)
               
                    Dim check1 As Boolean, check2 As Boolean
                    check1 = isExistNum(1, i, 9, i) 'Kiểm tra cột
                    check2 = isExistNum(r1, c2, r1 + 2, c2 + 2) 'Kiểm tra BlockArea
                   
                    'Nếu num chưa tồn tại thì:
                    If check1 = False And check2 = False Then
                       
                        Dim SetCnt As Long, x As Long
                        SetCnt = SetCnt + 1 'Số lượng cells có thể là đáp án
                        x = i 'Cột của cells hiện tại
                        'Hàng của cells hiện tại là r.
                       
                    End If
               
                End If
               
            Next i
           
            'Ghi đáp án
            If SetCnt = 1 Then Call AnswerSet(r, x, num)
           
            SetCnt = 0 'Reset

        End If

    Next num

End Sub

Sub Solution3_Col()

    'Nếu cột đã hoàn thành thì không cần giải
    If WorksheetFunction.CountBlank(Range(Cells(1, c), Cells(9, c))) = 0 Then
        Exit Sub
    End If

    For num = 1 To 9
   
        'Bắt đầu kiểm tra num tồn tại trong cột hay chưa thì tiến hành giải
        If isExistNum(1, c, 9, c) = False Then

            Dim i As Long
            For i = 1 To 9 'Kiểm tra tuần tự hàng 1 tới hàng 9
               
                If Cells(i, c).Value = "" Then
               
                    Dim r2 As Long
                    r2 = SearchBlockArea(i)
                   
                    Dim check1 As Boolean, check2 As Boolean
                    check1 = isExistNum(i, 1, i, 9) 'Kiểm tra hàng
                    check2 = isExistNum(r2, c1, r2 + 2, c1 + 2) 'Kiểm tra khối BlockArea
                   
                    'Nếu num chưa tồn tại thì:
                    If check1 = False And check2 = False Then
                       
                        Dim SetCnt As Long, y As Long
                        SetCnt = SetCnt + 1 'Số lượng cells có khả năng là đáp án
                        y = i 'Dòng của cells hiện tại
                        'Cột của cells hiện tại là c
                   
                    End If
               
                End If
               
            Next i
           
            If SetCnt = 1 Then Call AnswerSet(y, c, num)
           
            SetCnt = 0 'reset

        End If

    Next num

End Sub

Trên đây chúng tôi đã dịch xong toàn bộ các bài viết về giải sudoku từ website:

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

tuhocvba · 23/11/19

Tận hưởng thành quả:

Bạn cần đăng nhập để thấy đa phương tiện

Download:
Link 1:

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

Link 2:

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

tommy1003 · 21/2/20

Bài giải này hay và chi tiết quá. Cám ơn Admin.
Mình cũng thử tạo code riêng theo ý mình, code có thế:
- Tạo một đề bài Sudoku
- Xoá ngẫu nhiên số để người chơi bắt đầu chơi
- Nút solve để giải. Đang gặp vấn đề ở đây
Bạn nào yêu thích thì tham khảo Code của mình và bày mình cách tối ưu nhé. Hiện tại thì để Generate đề Sudoku mất từ 1s -50s tuỳ trường hợp. Nếu có cách nào hay hơn mình cũng muốn học hỏi.

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

tuhocvba · 25/9/21

Có thành viên bên GPE từng lớn tiếng cho rằng chỉ có đầu óc thần kinh có vấn đề mới cần 3 tháng để giải quyết bài toán này. Trước lời nói đó, tôi đã không đáp lại câu nào. Công sức trình bày tỉ mỉ trong topic này là không nhỏ, tôi hi vọng các bạn cảm thấy bài viết này là dễ hiểu, và học hỏi được nhiều điều từ đây.

Giải Sudoku bằng VBA

tuhocvba

Administrator

Euler

Administrator

giaiphapvba

Administrator

tuhocvba

Administrator

Euler

Administrator

vbano1

SMod

giaiphapvba

Administrator

vbano1

SMod

tuhocvba

Administrator

tommy1003

Yêu THVBA

tuhocvba

Administrator